cgi-bin/pup

   1 #!/usr/bin/perl -wT
   2
   3 # F*EX CGI for public upload
   4 #
   5 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
   6 #
   7
   8 use CGI::Carp qw(fatalsToBrowser);
   9
  10 # add fex lib
  11 (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
  12 die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  13
  14 $| = 1;
  15
  16 our $error = 'F*EX public upload ERROR';
  17 our $head = "$ENV{SERVER_NAME} F*EX public upload";
  18 our $locale = '';
  19
  20 # import from fex.ph
  21 our (@public_recipients);
  22
  23 # import from fex.pp
  24 our ($FEXHOME);
  25
  26 # load common code, local config: $FEXLIB/fex.ph
  27 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  28
  29 $from = $to = '';
  30
  31 chdir $spooldir or http_die("$spooldir - $!\n");
  32
  33 &check_maint;
  34
  35 my $qs = $ENV{QUERY_STRING};
  36 (my $multi) = $qs =~ s/(^|&)multi//;
  37
  38 # parse HTTP QUERY_STRING (parameter=value pairs)
  39 if ($qs) {
  40   foreach (split '&',$qs) {
  41     if (s/^(\w+)=//) {
  42       my $x = $1;
  43       # decode URL-encoding
  44       s/%([a-f0-9]{2})/chr(hex($1))/gie;
  45       if (/([<>\'\`\"\000-\040])/) {
  46         http_die(sprintf(
  47           "\"&#%s;\" is not allowed in URL parameter",
  48           ord($1)
  49         ));
  50       }
  51       setparam($x,$_);
  52     }
  53   }
  54 }
  55
  56 # parse HTTP POST body
  57 if ($ENV{REQUEST_METHOD} eq 'POST') {
  58   if ($ENV{CONTENT_TYPE} =~ /boundary=\"?([\w\-\+\/_]+)/) {
  59     $boundary = $1;
  60   } else {
  61     http_die("malformed HTTP POST (no boundary found)");
  62   }
  63
  64   binmode(STDIN,':raw');
  65
  66   READPOST: while (&nvt_read) {
  67     if (/^Content-Disposition:\s*form-data;\s*name="([a-z]\w*)"/i) {
  68       my $x = $1;
  69       while (&nvt_read) { last if /^\s*$/ }
  70       &nvt_read;
  71       setparam($x,$_);
  72       NEXTPART: while (&nvt_read) {
  73         last READPOST if /^--\Q$boundary--/;
  74         last NEXTPART if /^--\Q$boundary/;
  75       }
  76     }
  77   }
  78 }
  79
  80 unless (@public_recipients) {
  81   html_error($error,"No public recipients defined by administrator");
  82 }
  83
  84 if ($to and not grep /^\Q$to\E$/i,@public_recipients) {
  85   html_error($error,"$to is not a public recipient");
  86 }
  87
  88 if ($to and $from and checkaddress($from)) {
  89   nvt_print(
  90     "HTTP/1.1 302 Found",
  91     "Location: $ENV{PROTO}://$ENV{HTTP_HOST}/fup?from=$from&to=$to&id=PUBLIC",
  92     'Content-Length: 0',
  93     ""
  94   );
  95   exec($FEXHOME.'/bin/fexsrv') if $ENV{KEEP_ALIVE};
  96   exit;
  97 }
  98
  99 http_header('200 ok');
 100 print html_header($head);
 101
 102 my @locales;
 103 foreach my $locale (glob "$FEXHOME/locale/*") {
 104   if (-f "$locale/cgi-bin/pup") {
 105     my $langf = "$locale/lang.html";
 106     $locale =~ s:.*/::;
 107     $lang = $locale;
 108     if (open $langf,'<',$langf) {
 109       $lang = getline($langf);
 110       close $langf;
 111     }
 112     push @locales,"<a href=\"/pup?to=$to&locale=$locale\">$lang</a>";
 113   }
 114 }
 115 print "<h3>@locales</h3>\n" if @locales > 1;
 116
 117
 118 pq(qq(
 119   '<form name="upload"'
 120   '      action="/fup"'
 121   '      method="post"'
 122   '      accept-charset="UTF-8"'
 123   '      enctype="multipart/form-data">'
 124   '  <input type="hidden" name="id" value="PUBLIC">'
 125   '  <input type="hidden" name="autodelete" value="no">'
 126   '  <table border="1">'
 127 ));
 128
 129 if ($from) {
 130   pq(qq(
 131     '    <tr><td>your e-mail address:<td>$from</tr>'
 132     '    <input type="hidden" name="from" value="$from">'
 133   ));
 134 } else {
 135   pq(qq(
 136     '    <tr><td>your e-mail address:<td><input type="text" name="from" size="80"></tr>'
 137   ));
 138 }
 139
 140 if ($to) {
 141   pq(qq(
 142     '    <tr><td>recipient:<td>$to</tr>'
 143     '    <input type="hidden" name="to" value="$to">'
 144   ));
 145 } else {
 146   if ($multi) {
 147     foreach my $pr (@public_recipients) {
 148       push @pr,qq(<input type="checkbox" name="to" value="$pr">)
 149                ."<code>$pr</code><br>";
 150     }
 151     pq(qq(
 152       '    <tr><td>recipient:<td>@pr</tr>'
 153     ));
 154   } else {
 155     foreach my $pr (@public_recipients) {
 156       push @pr,"<option>$pr</option>";
 157     }
 158     pq(qq(
 159       '    <tr><td>recipient:<td><select name="to" size="1">@pr</select></tr>'
 160     ));
 161   }
 162 }
 163
 164 pq(qq(
 165   '  </table>'
 166   '  <p>'
 167   '  <input type="submit" name="continue" value="continue">'
 168   '</form>'
 169 ));
 170
 171
 172 # set parameter variables
 173 sub setparam {
 174   my ($v,$vv) = @_;
 175
 176   $v = uc(despace($v));
 177   if ($v eq 'LOCALE' and $vv =~ /^(\w+)$/) {
 178     $locale = $1;
 179   } elsif ($v eq 'FROM') {
 180     $from = normalize_email($vv);
 181   } elsif ($v eq 'TO') {
 182     $to = normalize_email($vv);
 183   }
 184 }
 185
 186
 187 # read one line from STDIN (net socket) and assign it to $_
 188 # returns number of read bytes
 189 sub nvt_read {
 190   my $len = 0;
 191
 192   if (defined ($_ = <STDIN>)) {
 193     debuglog($_);
 194     $len = length;
 195     s/\r?\n//;
 196   }
 197   return $len;
 198 }