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