cgi-bin/sex

   1 #!/usr/bin/perl -wT
   2
   3 # CGI for stream exchange
   4 #
   5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
   6
   7 use Fcntl       qw':flock :seek :mode';
   8 use POSIX       qw'mkfifo';
   9 use Digest::MD5 qw'md5_hex';
  10
  11 # add fex lib
  12 (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
  13 die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  14
  15 $| = 1;
  16
  17 # import from fex.pp
  18 our ($tmpdir,@logdir,$timeout,$fra,$bs);
  19
  20 # load common code, local config: $HOME/lib/fex.ph
  21 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  22
  23 chdir $spooldir or error(500,"$spooldir - $!");
  24
  25 # my $debuglog = "$tmpdir/sex.log";
  26 my $ra = $ENV{REMOTE_ADDR}||0;
  27 $fra .= '/'.$ENV{HTTP_X_FORWARDED_FOR} if $ENV{HTTP_X_FORWARDED_FOR};
  28 $timeout *= 10;
  29
  30 # normal / public :
  31 # in normal mode the recipient needs authentification, not the sender
  32 # in public mode the sender needs authentification, not the recipient
  33
  34 $user = $id = $pmode = $type = '';
  35 $stream = 'STDSTR';
  36 $mode = $ENV{REQUEST_METHOD} eq 'POST' ? 'PUSH' : 'POP';
  37
  38 # parse HTTP QUERY_STRING
  39 if (my $qs = $ENV{QUERY_STRING}) {
  40   $qs = decode_b64($qs) if $qs =~ /^\w+=*$/;
  41   foreach (split '&',$qs) { setparam(split '=',"$_=") };
  42 }
  43
  44 unless ($user) { error(400,"Missing user") }
  45 if ($mdomain and $user !~ /@/) { $user .= '@'.$mdomain }
  46 if ($user =~ /^anonymous/) {
  47   if (@anonymous_upload and ipin($ra,@anonymous_upload)) {
  48     mkdirp($user);
  49   } else {
  50     error(403,"Forbidden");
  51   }
  52 } else {
  53   unless (-f "$user/@") { error(404,"Unknown user $user") }
  54 }
  55 chdir $user or error(500,"$user - $!");
  56
  57 $stream = "STREAM/$stream";
  58
  59 if ($mode eq 'PUSH') {
  60   if ($pmode eq 'PUBLIC') {
  61     &authentificate;
  62     $stream =~ s:/STDSTR:/PUBLIC:;
  63   }
  64   mkdirp($stream);
  65   my $fifo = "$stream/fifo";
  66   unless (-p $fifo) {
  67     mkfifo($fifo,0600) or error(503,"Cannot create $fifo : $!");
  68   }
  69
  70   sexlog($mode);
  71
  72   my $lock = "$stream/lock";
  73   open $lock,'>>',$lock or error(503,"Cannot open $lock : $!");
  74   flock $lock,LOCK_EX|LOCK_NB or error(409,"$stream already in use");
  75
  76   chmod 0600,$fifo;
  77   unlink "$stream/mode";
  78   unlink "$stream/type";
  79   symlink $pmode,"$stream/mode" if $pmode;
  80   symlink $type, "$stream/type" if $type;
  81
  82   $SIG{PIPE} = sub {
  83     sleep 1;
  84     rmrf($stream);
  85     exit;
  86   };
  87   $SIG{ALRM} = sub {
  88     syswrite STDOUT,".";
  89     exit if $!;
  90     $ALARM = 1;
  91   };
  92   syswrite STDOUT,"HTTP/1.9 199 Hold on";
  93   for (my $i=0;$i<$timeout;$i++) {
  94     alarm(1);
  95     $ALARM = 0;
  96     # will hang until $stream is opend for reading by another process
  97     open $fifo,'>',$fifo and last;
  98     unless ($ALARM) { error(503,"Cannot open $fifo : $!") }
  99   }
 100   alarm(0);
 101   syswrite STDOUT,"\r\n";
 102
 103   unless (fileno $fifo) {
 104     rmrf($stream);
 105     error(504,"Timeout");
 106   }
 107
 108   header('200 OK');
 109
 110   $B = 0;
 111   $shutdown = sub { sexlog($B); rmrf($stream); exit; };
 112   $SIG{PIPE} = sub { sleep 1; &$shutdown; };
 113   # syswrite $fifo,$data if $data;
 114   while ($b = sysread(STDIN,$_,$bs)) {
 115     $B += $b;
 116     syswrite $fifo,$_ or die $!;
 117   }
 118
 119   &$shutdown;
 120 }
 121 elsif ($mode eq 'POP') {
 122   $stream =~ s:/STDSTR:/PUBLIC: if $id eq 'public';
 123   unless ($id eq 'public' and (readlink "$stream/mode"||'') eq 'PUBLIC'
 124           or $user =~ /^anonymous/) {
 125     &authentificate;
 126   }
 127   error(503,"No $stream for $user") unless -d $stream;
 128   $type = readlink "$stream/type" || '';
 129   $SIG{ALRM} = sub { error(504,"Timeout") };
 130   alarm($timeout);
 131   my $fifo = "$stream/fifo";
 132   if (-e $fifo and not -r $fifo) { error(503,"$stream already in use") }
 133   open $fifo,'<',$fifo or error(503,"Cannot open $fifo : $!");
 134   chmod 0,$fifo;
 135   alarm(0);
 136   header('200 OK',$type);
 137   sexlog($mode);
 138
 139   while (sysread($fifo,$_,$bs)) {
 140     syswrite STDOUT,$_ or die $!;
 141   }
 142   unlink $fifo;
 143   exit;
 144
 145 }
 146 else {
 147   error(405,"Unknown Request");
 148 }
 149
 150 exit;
 151
 152
 153 sub setparam {
 154   my ($v,$vv) = @_;
 155
 156   $v = uc(despace($v));
 157   $vv = untaint(normalize($vv));
 158   # $param{$v} = $vv;
 159   if    ($v eq 'USER') { $user  = lc(despace($vv)) }
 160   elsif ($v eq 'ID') { $id = despace($vv) }
 161   elsif ($v eq 'MODE') { $pmode = uc(despace($vv)) }
 162   elsif ($v eq 'TYPE') { $type = uc(despace($vv)) }
 163   elsif ($v eq 'STREAM') { $stream = normalize_filename($vv) }
 164   elsif ($v eq 'BS' and $vv =~ /(\d+)/) { $bs = $1 }
 165   elsif ($v eq 'TIMEOUT' and $vv =~ /(\d+)/) { $timeout = $1 }
 166   elsif ($v eq 'ANONYMOUS') { $id = $user ='anonymous'; $stream = $vv; }
 167 }
 168
 169 sub sexlog {
 170   my $msg = "@_";
 171
 172   $msg =~ s/\n/ /g;
 173   $msg =~ s/\s+$//;
 174   $msg = sprintf "%s [%s_%s] %s (%s) %s\n",
 175                   isodate(time),$$,$ENV{REQUESTCOUNT},$user,$fra,$msg;
 176
 177   foreach my $log (@logdir) {
 178     if (open $log,'>>',"$log/sex.log") {
 179       flock $log,LOCK_EX;
 180       seek $log,0,SEEK_END;
 181       printf {$log} $msg;
 182       close $log;
 183     }
 184   }
 185 }
 186
 187 sub sigdie {
 188   local $_ = shift;
 189   chomp;
 190   sigexit('DIE',$_);
 191 }
 192
 193 sub sigexit {
 194   my ($sig) = @_;
 195   my $msg = "@_";
 196
 197   $msg =~ s/\n/ /g;
 198   $msg =~ s/\s+$//;
 199   $msg = sprintf "%s %s (%s) caught SIGNAL %s\n",
 200                  isodate(time),$user||'-',$fra||'-',$msg;
 201
 202   foreach my $log (@logdir) {
 203     if (open $log,'>>',"$log/sex.log") {
 204       flock $log,LOCK_EX;
 205       seek $log,0,SEEK_END;
 206       printf {$log} $msg;
 207       close $log;
 208     }
 209   }
 210   if ($sig eq 'DIE') {
 211     shift;
 212     die "@_\n";
 213   } else {
 214     die "SIGNAL @_\n";
 215   }
 216 }
 217
 218 sub error {
 219   nvt_print("HTTP/1.1 @_");
 220   exit;
 221 }
 222
 223 sub header {
 224   my ($status,$type) = @_;
 225
 226   return if $HTTP_HEADER;
 227   $HTTP_HEADER = $status;
 228
 229   nvt_print("HTTP/1.1 $status");
 230   if ($mode eq 'POP') {
 231     nvt_print("Server: sexsrv");
 232     if ($type eq 'GZIP') {
 233       nvt_print("Content-Type: application/gzip");
 234     } else {
 235       nvt_print("Content-Type: application/binary");
 236     }
 237     nvt_print("Expires: 0");
 238     nvt_print("Cache-Control: no-cache");
 239     nvt_print("Connection: close");
 240   }
 241   nvt_print("");
 242 }
 243
 244 sub authentificate {
 245   my $rid;
 246
 247   error(400,"Missing auth-ID") unless $id;
 248   open $id,'<','@' or error(401,"$user/@ - $!");
 249   chomp($rid = <$id>||'');
 250   close $id;
 251   if ($rid and $sid and $id =~ /^(MD5H:)/) {
 252     $rid = $1 . md5_hex($rid.$sid);
 253   }
 254   error(401,"Wrong auth-ID") if $rid ne $id;
 255 }