]> git.treefish.org Git - fex.git/blob - cgi-bin/sex
ab7abc8c68153a872117d829a2b28ecf4a45fdbd
[fex.git] / 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   exit;
143
144 }
145 else {
146   error(405,"Unknown Request");
147 }
148
149 exit;
150
151
152 sub setparam {
153   my ($v,$vv) = @_;
154
155   $v = uc(despace($v));
156   $vv = untaint(normalize($vv));
157   # $param{$v} = $vv;
158   if    ($v eq 'USER') { $user  = lc(despace($vv)) }
159   elsif ($v eq 'ID') { $id = despace($vv) }
160   elsif ($v eq 'MODE') { $pmode = uc(despace($vv)) }
161   elsif ($v eq 'TYPE') { $type = uc(despace($vv)) }
162   elsif ($v eq 'STREAM') { $stream = normalize_filename($vv) }
163   elsif ($v eq 'BS' and $vv =~ /(\d+)/) { $bs = $1 }
164   elsif ($v eq 'TIMEOUT' and $vv =~ /(\d+)/) { $timeout = $1 }
165   elsif ($v eq 'ANONYMOUS') { $id = $user ='anonymous'; $stream = $vv; }
166 }
167
168 sub sexlog {
169   my $msg = "@_";
170
171   $msg =~ s/\n/ /g;
172   $msg =~ s/\s+$//;
173   $msg = sprintf "%s [%s_%s] %s (%s) %s\n",
174                   isodate(time),$$,$ENV{REQUESTCOUNT},$user,$fra,$msg;
175
176   foreach my $log (@logdir) {
177     if (open $log,'>>',"$log/sex.log") {
178       flock $log,LOCK_EX;
179       seek $log,0,SEEK_END;
180       printf {$log} $msg;
181       close $log;
182     }
183   }
184 }
185
186 sub sigdie {
187   local $_ = shift;
188   chomp;
189   sigexit('DIE',$_);
190 }
191
192 sub sigexit {
193   my ($sig) = @_;
194   my $msg = "@_";
195
196   $msg =~ s/\n/ /g;
197   $msg =~ s/\s+$//;
198   $msg = sprintf "%s %s (%s) caught SIGNAL %s\n",
199                  isodate(time),$user||'-',$fra||'-',$msg;
200
201   foreach my $log (@logdir) {
202     if (open $log,'>>',"$log/sex.log") {
203       flock $log,LOCK_EX;
204       seek $log,0,SEEK_END;
205       printf {$log} $msg;
206       close $log;
207     }
208   }
209   if ($sig eq 'DIE') {
210     shift;
211     die "@_\n";
212   } else {
213     die "SIGNAL @_\n";
214   }
215 }
216
217 sub error {
218   nvt_print("HTTP/1.1 @_");
219   exit;
220 }
221
222 sub header {
223   my ($status,$type) = @_;
224
225   return if $HTTP_HEADER;
226   $HTTP_HEADER = $status;
227
228   nvt_print("HTTP/1.1 $status");
229   if ($mode eq 'POP') {
230     nvt_print("Server: sexsrv");
231     if ($type eq 'GZIP') {
232       nvt_print("Content-Type: application/gzip");
233     } else {
234       nvt_print("Content-Type: application/binary");
235     }
236     nvt_print("Expires: 0");
237     nvt_print("Cache-Control: no-cache");
238     nvt_print("Connection: close");
239   }
240   nvt_print("");
241 }
242
243 sub authentificate {
244   my $rid;
245
246   error(400,"Missing auth-ID") unless $id;
247   open $id,'<','@' or error(401,"$user/@ - $!");
248   chomp($rid = <$id>||'');
249   close $id;
250   if ($rid and $sid and $id =~ /^(MD5H:)/) {
251     $rid = $1 . md5_hex($rid.$sid);
252   }
253   error(401,"Wrong auth-ID") if $rid ne $id;
254 }