#!/usr/bin/perl -wT
# vim: set sw=4 ts=4 si et : 
# Copyright: GPL
# author: Guido Socher
# This script is used to upload data 
# Usage: http://localhost/cgi-bin/sdat?pw=sec&a=buttonpress
# The only mandatory parameter is the password (pw)
# Key and value parameters together must not be longer than 20 characters.
# Longer parameters are ignored and not stored.
# There must not be more than 16 key value pairs.
# The key value pairs must only consist of letters, numbers underscore dot and minus [a-zA-Z\.\-\_0-9]
#print "<a href="http://ds.tuxgraphics.org/cgi-bin/upld">[do new search]</a> <a href="http://ds.tuxgraphics.org/cgi-bin/upld?iplookup=83.6.168.247&action=show">[refresh]</a>"


use strict;
no locale;
#
sub cgi_receive();
#------------------------------------------
# please edit the following 2 lines and adapt them. You can leave them as is for initial testing.
#
my $password="secret"; # you can only store data or view data if you know this password, please use only letters and numbers.
my $dbfile="/tmp/sdat.txt"; # the directory where the data storage file sdat.txt resides needs to be writable for the web server process
#------------------------------------------
#
#global data:
my $FORM;
my $formpath ="/cgi-bin/sdat"; # overwitten later by the cgi_receive();
my $remip="0.0.0.0";
#
$FORM=cgi_receive();
#
#------------------------------------------
umask 0022;
#
if (scalar keys %{$FORM}){ # we have some keys
    # the parameters pw id and ot (offset time) are mandatory:
    if ($FORM->{'rview'} eq "1"){
        if ($FORM->{'viewpw'}){
            if ($FORM->{'viewpw'} eq $password){
                print "Content-type: text/html; charset=iso-8859-2\n\n";
                print "<h2>Lista dostępnych rekordów</h2><u>IP !! server time !! key value pairs ...</u><br>or<br><u>IP !! server time !! time of data !! time of data in sec !! key value pairs ...</u>\n<pre>\n";
                # first try to read the previous rotated file to make sure
                # we still have data to show after the file was just rotated. Obviously
                # we want to no longer see  some data at rotation but not all at once.
                if (open(FF,"$dbfile".".0")){
                    while(<FF>){
                        s/\&/&amp;/g;
                        s/\</&lt;/g;
                        print;
                    }
                    close FF;
                }elsif (open(FF,"$dbfile")){
                    while(<FF>){
                        s/\&/&amp;/g;
                        s/\</&lt;/g;
                        print;
                    }
                    close FF;
                }else{
                    print "no data available\n";
                }
                    print "</pre><hr><a href=\"$formpath?rview=1&viewpw=$password>[refresh]</a>\n";
                    exit(0);
            }else{
                print "Content-type: text/html; charset=iso-8859-1\n\n";
                print "Invalid password\n";
            }
        }else{
            print "Content-type: text/html; charset=iso-8859-1\n\n";
            print qq|<html><head><title>List of available records, login</title></head><body>
<h2>List of available records</h2>
<form method="post" action="$formpath">
Password: <input type="password" name="viewpw" size="16">
<input type="hidden" name="rview" value="1">
<input type="submit" value="show records">
</form>
<br clear="all">
<hr>
</body>
</html>
|;
        exit(0);
       }
    }elsif ($FORM->{'pw'} ){
        if ($FORM->{'pw'} ne $password){
            print "Status: 401 Unauthorized\n";
            print "Content-type: text/html\n\n";
            print "<h1>401 Unauthorized, account expired</h1>\n";
            exit(0);
        }
        my @ltime = gmtime;
        my $server_time =  sprintf("%04d-%02d-%02d_%02d:%02d_GMT",1900 + $ltime[5],$ltime[4] + 1,$ltime[3],$ltime[2],$ltime[1]);
        open(FF,">>$dbfile")||die "ERROR: can not write db file\n";
        print FF $remip .'!!'. $server_time .'!!';
        if (defined ($FORM->{'ot'}) && $FORM->{'ot'}=~/(\d{1,5})/){
            my $clean_ot=$1;
            my $t=time();
            if ($t > $clean_ot * 60){
                $t-=$clean_ot * 60;
            }
            my @ltime = gmtime($t);
            my $correcedtime =  sprintf("%04d-%02d-%02d %02d:%02d:%02d GMT",1900 + $ltime[5],$ltime[4] + 1,$ltime[3],$ltime[2],$ltime[1],$ltime[0]);
            print FF $correcedtime .'!!'.$t.'!!';
        }
        my $v;
        my $maxcount=16; # max 16 records
        for my $k (sort keys %{$FORM}){
            next if ($k eq 'pw' );
            $maxcount--;
            last if ($maxcount<1);
            $v=$FORM->{$k};
            next if (length($k . $v)> 20);
            # for security reason we clean the fields:
            $k=~s/[^\w\.\-]//g;
            $v=~s/[^\w\.\-]//g;
            # do not use my separators:
            $k=~s/!!//g;
            $v=~s/!!//g;
            print FF "$k=$v".'!!';
        }
        print FF "\n";
        close FF;
        # answer the upload client with a short OK
        print "Content-type: text/html\n\n";
        print "<p><a href=$formpath>OK</a></p>\n";
        exit(0);
    }
}else{
    print "Content-type: text/html; charset=iso-8859-1\n\n";
    print qq|<html><head><title>embedded client upload</title></head><body>
<h2>Tuxgraphics embedded web client upload</h2>
The mandatory parameter which you need to give is:<br>
pw=YourPassword&amp;key=value;....
<br>
<br>
Each key and value pair must not exceed a length of 20 characters.
The records will not be store if they do exceed this limit.
<br>
<br>
If you pass the parameter "ot" then not only the time at which the record arrived
at the server will be shown but as well the time at which the data was generated.
The "ot" is in units of minutes. This is useful if data has to be buffered locally
on the client during a network problem. "ot" should be zero if this is not a record that
needed to be re-transmitted.
<br>
<br>
You can test the functionallity of this cgi-interface simply form your web browser by
entering this url:<br> http://This.Server$formpath?pw=YourPassword&amp;k1=0&amp;k2=221
<br>
Please replace This.Server and YourPassword with proper values
<br>
<br>
To see the data that was uploaded simply look at the generated text file on
the server or <a href="$formpath?rview=1">click here to view the file</a>
<br clear="all">
<hr>
</body>
</html>
|;
}
#--------------------------------------------------------
sub cgi_receive(){
    #
    delete $ENV{'IFS'};
    delete $ENV{'ENV'};
    $ENV{'PATH'}="/bin:/usr/bin";
    my $buffer = "";
    my %RFORM;
    my $pair;
    my $name;
    my $value;
    if ($ENV{'GATEWAY_INTERFACE'} && $ENV{'GATEWAY_INTERFACE'} =~ /CGI/){
        if ($ENV{'REQUEST_METHOD'} eq 'GET') {
            if (length($ENV{'QUERY_STRING'})> 1000){
                print "Status: 400 Bad Request\n";
                print "Content-type: text/html\n\n";
                print "<h1>Bad Request, data too long</h1>\n";
                exit(0);
            }
            if($ENV{'QUERY_STRING'}){
                $buffer = $ENV{'QUERY_STRING'};
            }
        }elsif ($ENV{'REQUEST_METHOD'} eq 'POST' && $ENV{'CONTENT_LENGTH'}) {
            if ($ENV{'CONTENT_LENGTH'} > 1000){
                print "Status: 400 Bad Request\n";
                print "Content-type: text/html\n\n";
                print "<h1>Bad Request, data too long</h1>\n";
                exit(0);
            }
            read(STDIN, $buffer,$ENV{'CONTENT_LENGTH'});
        }elsif ($ENV{'REQUEST_METHOD'} eq 'HEAD') {
            print "Content-type: text/html\n\n";
            print "<p>Hello robot this is a cgi-script</p>\n";
            exit(0);
        }else{
            print "Status: 400 Bad Request\n";
            print "Content-type: text/html\n\n";
            print "<h1>Bad Request</h1>\n";
            exit(0);
        }
    }else {
        $buffer = $ARGV[0] if ($ARGV[0]);
    }
    # now decode it:
    #
    # Split the name-value pairs
    foreach $pair (split(/\&/, $buffer)){
        ($name, $value) = split(/=/, $pair);
        $value = "" unless (defined $value);
        # Un-Webify plus signs and %-encoding
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        # protect against too much data:
        $RFORM{$name} = substr($value,0,400);
    }
    if ($ENV{'SCRIPT_NAME'} ){
        $formpath=$ENV{'SCRIPT_NAME'} ;
    }
    if ($ENV{'REMOTE_ADDR'} && $ENV{'REMOTE_ADDR'}=~/\d\.\d/){
        $remip=$ENV{'REMOTE_ADDR'};
    }
    %ENV=();
    $ENV{'IFS'}=" ";
    $ENV{'PATH'}="/sbin:/bin:/usr/sbin:/usr/bin";
    return \%RFORM;
}
#--------------------------------------------------------
__END__
