#    This source code file is part of the "mod_survey" package.
#
#    Copyright (C) 2004  Joel Palmius
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program (probably in a file named "LICENSE.txt" or the like);
#    if not, write to:
#
#    Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

#!/usr/bin/perl

package Survey::Argument;
use strict;

use Survey::Language;

use CGI qw/:standard/;

sub new
{
    my ($crap, $session) = @_;
    my ($valid) = 0;
    my $self = {};
    bless($self);

    if ($ENV{"CONTENT_TYPE"} =~ m/multipart/)
    {

        # Assume we are doing upload. Only allowed in admin for now,
        # thus fake action and so on. This is ugly.
        $self->{"ARG_action"}     = "admin";
        $self->{"ARG_admin"}      = "flush";
        $self->{"ARG_flush"}      = "upload";
        $self->{"ARG_file"}       = "1";
        $self->{"noillegalcheck"} = "1";
    }
    else
    {
        if ($ENV{"REQUEST_METHOD"} eq "POST")
        {
            read(STDIN, $ENV{"QUERY_STRING"}, $ENV{'CONTENT_LENGTH'});
        }
    }

    $self->{QUERY_STRING} = $ENV{"QUERY_STRING"} || "action=display";
    $self->{ERROR}        = 0;
    $self->{ERRORCODE}    = 0;
    $self->{SESSION}      = $session;

    #print $self->{QUERY_STRING};

    @{ $self->{DEFINED} } = ("");

    $self->ParseMulti();
    $self->ParseQuery();

    if ($self->ArgByName("action") eq "display") { $valid = $self->PlaceDisplay(); }

    # added in CRU patch (MJ/20020820)
    if ($self->ArgByName("action") eq "soap") { $valid = $self->PlaceDisplay(); }

    # added in CRU patch (MJ/200208)
    if ($self->ArgByName("action") eq "retrieve") { $valid = $self->PlaceDisplay(); }
    if ($self->ArgByName("action") eq "submit")
    {
        if   ($self->ArgByName("realaction") eq "persistance") { $valid = $self->PlaceDisplay(); }
        else                                                   { $valid = $self->PlaceSubmit(); }
    }

    # added in CRU patch (MJ/200208)
    if ($self->ArgByName("save")   eq "save")  { $valid = $self->PlaceSubmit(); }
    if ($self->ArgByName("action") eq "admin") { $valid = $self->PlaceAdmin(); }

    # Display actions for Presentation
    if ($self->ArgByName("action") eq "graph")  { $valid = 1; }
    if ($self->ArgByName("action") eq "table")  { $valid = 1; }
    if ($self->ArgByName("action") eq "data")   { $valid = 1; }
    if ($self->ArgByName("action") eq "logout") { $valid = 1; }

    if (!$valid)
    {
        my ($acti) = $self->ArgByName("action");
        if ($acti =~ /[\<\>]/)
        {
            $self->{ERROR}     = lprint("Script injection attempt detected");
            $self->{ERRORCODE} = 5;
        }
        else
        {
            $self->{ERROR}     = lprint("Action ") . $self->ArgByName("action") . lprint(" is not valid.");
            $self->{ERRORCODE} = 1;
        }
    }

    return ($self);
}

sub ParseMulti
{
    my ($self) = shift;

    my ($ses) = $self->{SESSION};

    my ($ssofar) = $ses->getValue("submittedsofar");
    if ($ssofar)
    {
        my (@sofar) = split(/\x03/, $ssofar);

        my ($name, $value);

        foreach $name (@sofar)
        {
            $value                                     = $ses->getValue("SUBMITTED_$name");
            $self->{ "ARG_" . $name }                  = $value;
            $self->{ "ARG_" . $name . "_FROMSESSION" } = 1;
        }
    }

    1;
}

sub ParseQuery
{
    my ($self) = shift;
    my (@args, $cell, $name, $value, $fullName);

    $self->{QUERY_STRING} =~ s/\+/\ /g;

    # MH 210502 This has to be done after splitting!
    #  $self->{QUERY_STRING} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

    @args = split(/&/, $self->{QUERY_STRING});

    map s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg, @args;

    # modified by P. Sweatman to handle MultiChoice statments Nov 01
    # instead of just setting the value to the space defined by ARG_$name, we
    # first check to see if the space is null.  If it is, just assign the value.
    # If it's not, we append the new value to the old value, seperating things with
    # a comma.
    # This block read:
    #  foreach $cell (@args)
    #  {
    #    ($name,$value) = split(/=/,$cell,2);
    #    $self->{"ARG_" . $name} = $value;
    #  }

    #start change Nov 01
    foreach $cell (@args)
    {
        ($name, $value) = split(/=/, $cell, 2);
        $fullName = "ARG_" . $name;
        push(@{ $self->{DEFINED} }, $name);

        # MH 210502
        # Illegal value checking / replacement has to be done before values are rememberd
        # added '&' to illegal values - it confuses too many output formats.
        if (!$self->{"noillegalcheck"})
        {
            if ($ENV{"_SURVEY_PROTESTILLEGAL"})
            {
                if ($value =~ /[\x00-\x08\x0b\x0c\x0e-\x1f]/)
                {
                    $self->{ERROR}     = lprint("Submit contained illegal characters");
                    $self->{ERRORCODE} = 4;
                }
            }
            else
            {
                $value =~ s/[\x00-\x08\x0b\x0c\x0e-\x1f]/\|\|/g;
            }
        }

        if (($self->{$fullName} eq "") || (!defined($self->{"DEFINED_$fullName"})))
        {
            $self->{ "ARG_" . $name } = $value;

            # So we know this was actually submitted now
            $self->{ "QUERY_" . $name } = $value;
        }
        else
        {
            if ($value ne "!")
            {
                $self->{$fullName} = $self->{$fullName} . ",$value";

                # Separate for checking values submitted *for this page*
                $self->{ "QUERY_" . $name } = $self->{ "QUERY_" . $name } . ",$value";
            }
        }
        $self->{"DEFINED_$fullName"} = 1;

        #end change Nov 01
    }

    1;
}

sub PlaceDisplay
{
    my ($self) = shift;

    # -- Implement argument checking
    #    (not that there is much to check)

    1;
}

sub PlaceSubmit
{
    my ($self) = shift;

    if (!$self->ArgByName("key"))
    {
        $self->{ERROR}     = lprint("Key not defined in submit");
        $self->{ERRORCODE} = 2;
    }
    1;
}

sub PlaceAdmin
{
    my ($self) = shift;
    my (%valid);

    $valid{"data"}   = "...";
    $valid{"source"} = "...";
    $valid{"debug"}  = "...";
    $valid{"stats"}  = "...";
    $valid{"flush"}  = "...";

    if ((!$valid{ $self->ArgByName("admin") }) && ($self->ArgByName("admin")))
    {
        $self->{ERROR}     = "\"" . $self->ArgByName("admin") . "\" " . lprint("is not a valid administrative task.");
        $self->{ERRORCODE} = 3;
    }

    # -- Implement argument checking for admin tasks

    1;
}

sub ArgByName
{
    my ($self, $name) = @_;
    return $self->{ "ARG_" . $name };
}

sub Error
{
    my ($self) = shift;
    return $self->{ERROR};
}

sub PrintErrorDescription
{
    my $self = shift;

    my ($e)     = $self->{ERRORCODE};
    my ($found) = 0;

    my ($lb) = "<b>\&lt\;";
    my ($rb) = "\&gt\;</b>";

    print "    <br /><br />\n    ";

    if ($e)
    {
        if ($e eq 1)
        {
            print "<b><i>[" . lprint("ARGUMENT ERROR 1, ACTION IS NOT VALID") . "]</i></b> ";
            print lprint('The supplied value for the argument "action" is not valid. ');
            print lprint("Valid actions are ")
              . "<b>display</b>, <b>submit</b>, <b>retrieve</b> "
              . lprint("and")
              . "<b>admin</b>.";
            $found = 1;
        }
        if ($e eq 2)
        {
            print "<b><i>[" . lprint("ARGUMENT ERROR 2, KEY IS NOT DEFINED") . "]</i></b> ";
            print lprint(
"As a security measure, a valid key has to be given when submitting data. No such key was found in the query string. ");
            $found = 1;
        }
        if ($e eq 3)
        {
            print "<b><i>[" . lprint("ARGUMENT ERROR 3, IS NOT A VALID ADMINISRATIVE TASK") . "]</i></b> ";
            print lprint('The supplid value for the argument "admin" is not valid. ');
            print lprint("Valid administrative tasks are")
              . " <b>data</b>, <b>stats</b>, <b>debug</b>, <b>source</b> "
              . lprint("and")
              . " <b>flush</b>.";
            $found = 1;
        }
        if ($e eq 4)
        {
            print "<b><i>[" . lprint("ARGUMENT ERROR 4, SUBMIT CONTAINED ILLEGAL CHARACTERS") . "]</i></b> ";
            print lprint("Submitted data cannot contain some specific characters, most notably");
            print " \\x00 " . lprint("to") . " \\x1F. ";
            print lprint('Please press "back" in your browser and remove these characters from your answers.');
            $found = 1;
        }
        if ($e eq 5)
        {
            print "<b><i>[" . lprint("ARGUMENT ERROR 5, SCRIPT INJECTION ATTEMPT DETECTED") . "]</i></b> ";
            print lprint(
                "One system parameter contained illegal characters normally associated with script injection attempts.")
              . " ";
            print lprint(
                  "If you did not do this, then please report a possible security breach to the system administrator.");
            $found = 1;
        }

        if (!$found)
        {
            print lprint("This error is not in the knowledge base, so I guess the programmer has made a mistake.");
        }
    }
    else
    {
        print "<i>[" . lprint("ARGUMENT ERROR 0, NO ERROR") . "]</i> ";
        print lprint(
                "No error has occured, but the programmer has for some reason called PrintErrorDescription() anyway. ");
        print lprint("I guess the programmer has again made a mistake, something that is a very common event indeed.");
    }
    print "\n    <br /><br />\n";

    1;
}

1;