Original release 20150826

[fex.git] / cgi-bin / fuc

diff --git a/cgi-bin/fuc b/cgi-bin/fuc
index 864a3de5966ab1c1b5ef971a323260697531e385..661c897367a7418beabb0ec97bf7b57a693a3a3f 100755 (executable)
--- a/cgi-bin/fuc
+++ b/cgi-bin/fuc
@@ -1,19 +1,16 @@
 #!/usr/bin/perl -wT
 
 #!/usr/bin/perl -wT
 

-# FEX CGI for user control 
+# FEX CGI for user control

 # (subuser, groups, address book, one time upload key, auth-ID, etc)
 #
 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
 #
 
 # (subuser, groups, address book, one time upload key, auth-ID, etc)
 #
 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
 #
 

-use CGI         qw(:standard);
-use CGI::Carp  qw(fatalsToBrowser);
+BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
+

 use Fcntl      qw(:flock);
 use Digest::MD5        qw(md5_hex);
 
 use Fcntl      qw(:flock);
 use Digest::MD5        qw(md5_hex);
 

-$CGI::LIST_CONTEXT_WARN = 0;
-$CGI::LIST_CONTEXT_WARN = 0;
-

 # add fex lib
 ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
 die "$0: no $FEXLIB\n" unless -d $FEXLIB;
 # add fex lib
 ($FEXLIB) = $ENV{FEXLIB} =~ /(.+)/;
 die "$0: no $FEXLIB\n" unless -d $FEXLIB;


@@ -49,10 +46,12 @@ if ($qs) {
   if ($qs =~ /ab=load/)     { $ab = 'load' }
 }
 
   if ($qs =~ /ab=load/)     { $ab = 'load' }
 }
 

-# look for CGI POST parameters
-foreach my $v (param) {
-  my $vv = param($v);
-  debuglog("Param: $v=\"$vv\"");
+# look for CGI parameters
+our %PARAM;
+&parse_parameters;
+foreach my $v (keys %PARAM) {
+  my $vv = $PARAM{$v};
+  # debuglog("Param: $v=\"$vv\"");

   if ($v =~ /^akey$/i) {
     $akey = $1 if $vv =~ /^(\w+)$/;
     next;
   if ($v =~ /^akey$/i) {
     $akey = $1 if $vv =~ /^(\w+)$/;
     next;


@@ -65,7 +64,7 @@ foreach my $v (param) {
     $v =~ /^notification$/i    ? $notification = checkchars('parameter',$vv):
     $v =~ /^disclaimer$/i      ? $disclaimer   = $vv:
     $v =~ /^encryption$/i      ? $encryption   = checkchars('parameter',$vv):
     $v =~ /^notification$/i    ? $notification = checkchars('parameter',$vv):
     $v =~ /^disclaimer$/i      ? $disclaimer   = $vv:
     $v =~ /^encryption$/i      ? $encryption   = checkchars('parameter',$vv):

-    $v =~ /^pubkey$/i          ? $pubkey       = $vv:
+    $v =~ /^pubkey$/i          ? $pubkey       = $PARAM{$v}{data}:

     $v =~ /^reminder$/i                ? $reminder     = checkchars('parameter',$vv):
     $v =~ /^mime$/i            ? $mime         = checkchars('parameter',$vv):
     $v =~ /^comment$/i         ? $comment      = decode_utf8(normalize($vv)):
     $v =~ /^reminder$/i                ? $reminder     = checkchars('parameter',$vv):
     $v =~ /^mime$/i            ? $mime         = checkchars('parameter',$vv):
     $v =~ /^comment$/i         ? $comment      = decode_utf8(normalize($vv)):


@@ -79,7 +78,10 @@ foreach my $v (param) {
   $ESAC;
 }
 
   $ESAC;
 }
 

-$group = lc $group if $group and $group ne 'NEW';
+if ($group and $group ne 'NEW') {
+  $group = lc $group;
+  $group =~ s/[^\w\*%^+=:,.!-]/_/g;
+}

 $group = '' if $nomail;
 $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 
 $group = '' if $nomail;
 $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 


@@ -89,11 +91,11 @@ if ($akey) {
 
   # sid is not set with web browser
   my $idf = "$akeydir/$akey/@";
 
   # sid is not set with web browser
   my $idf = "$akeydir/$akey/@";

-    
+

   if (open $akey,'<',$idf and $id = getline($akey)) {
     close $akey;
     $idf =~ /(.*)\/\@/;
   if (open $akey,'<',$idf and $id = getline($akey)) {
     close $akey;
     $idf =~ /(.*)\/\@/;

-    $user = readlink $1 
+    $user = readlink $1

       or http_die("internal server error: no $akey symlink $1");
     $user =~ s:.*/::;
     $user = untaint($user);
       or http_die("internal server error: no $akey symlink $1");
     $user =~ s:.*/::;
     $user = untaint($user);


@@ -121,7 +123,7 @@ if ($user and $akey and $qs and $qs =~ /info=(.+?)&skey=(.+)/) {
 
 
 if ($user and $id) {
 
 
 if ($user and $id) {

-  if (-e "$user/\@CAPTIVE") { html_error($error,"captive user") }  
+  if (-e "$user/\@CAPTIVE") { html_error($error,"captive user") }

   unless (open $idf,'<',"$user/@") {
     faillog("user $from, id $id");
     html_error($error,"wrong user or auth-ID");
   unless (open $idf,'<',"$user/@") {
     faillog("user $from, id $id");
     html_error($error,"wrong user or auth-ID");


@@ -151,9 +153,9 @@ if ($user and $id) {
 }
 
 # empty POST? ==> back to foc
 }
 
 # empty POST? ==> back to foc

-if ($ENV{REQUEST_METHOD} eq 'POST' and not 
+if ($ENV{REQUEST_METHOD} eq 'POST' and not

     ($subuser or $notify or $nid or $ssid or $group or $ab or $gm or $tools
     ($subuser or $notify or $nid or $ssid or $group or $ab or $gm or $tools

-     or $disclaimer or $encryption or $pubkey)) 
+     or $disclaimer or $encryption or $pubkey))

 {
   nvt_print(
     "HTTP/1.1 302 Found",
 {
   nvt_print(
     "HTTP/1.1 302 Found",


@@ -222,7 +224,7 @@ if ($subuser and $otuser) {
   my $okey = randstring(8);
   my $okeyd = "$user/\@OKEY";
   mkdir $okeyd;
   my $okey = randstring(8);
   my $okeyd = "$user/\@OKEY";
   mkdir $okeyd;

-  symlink $otuser,"$okeyd/$okey" 
+  symlink $otuser,"$okeyd/$okey"

     or http_die("cannot create OKEY $okeyd/$okey : $!\n");
   my $url = "$fup?to=$user&okey=$okey";
   pq(qq(
     or http_die("cannot create OKEY $okeyd/$okey : $!\n");
   my $url = "$fup?to=$user&okey=$okey";
   pq(qq(


@@ -353,10 +355,11 @@ if ($user and $akey and defined $ab) {
       '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
       '</body></html>'
     ));
       '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
       '</body></html>'
     ));

+    exit;

   } else {
     $ab =~ s/[\r<>]//g;
     $ab =~ s/\s*$/\n/;
   } else {
     $ab =~ s/[\r<>]//g;
     $ab =~ s/\s*$/\n/;

-    
+

     foreach (split(/\n/,$ab)) {
       s/^\s+//;
       s/\s+$//;
     foreach (split(/\n/,$ab)) {
       s/^\s+//;
       s/\s+$//;


@@ -376,7 +379,7 @@ if ($user and $akey and defined $ab) {
         push @badalias,$_;
       }
     }
         push @badalias,$_;
       }
     }

-    
+

     if (@badalias) {
       print "<h2>ERROR: bad aliases:</h2>\n<ul>";
       foreach my $ba (@badalias) { print "<li>$ba" }
     if (@badalias) {
       print "<h2>ERROR: bad aliases:</h2>\n<ul>";
       foreach my $ba (@badalias) { print "<li>$ba" }


@@ -390,8 +393,8 @@ if ($user and $akey and defined $ab) {
       ));
       exit;
     }
       ));
       exit;
     }

-    
-    open my $AB,'>',"$user/\@ADDRESS_BOOK" 
+
+    open my $AB,'>',"$user/\@ADDRESS_BOOK"

       or http_die("cannot open $user/\@ADDRESS_BOOK - $!\n");
     print {$AB} $ab;
     close $AB;
       or http_die("cannot open $user/\@ADDRESS_BOOK - $!\n");
     print {$AB} $ab;
     close $AB;


@@ -514,10 +517,10 @@ if ($user and $pubkey) {
   my $pk;
   local $/;
   local $_;
   my $pk;
   local $/;
   local $_;

-  
-  open $gf,">$gf.pk" or http_die("cannot write $gf - $!\n");
-  print {$gf} <$pubkey>;
-  close $gf;
+
+  open $pk,">$gf.pk" or http_die("cannot write $gf.pk - $!\n");
+  print {$pk} $pubkey;
+  close $pk;

   unlink $gf;
   system "gpg --batch --no-default-keyring --keyring $gf --import".
          "< $gf.pk >/dev/null 2>&1";
   unlink $gf;
   system "gpg --batch --no-default-keyring --keyring $gf --import".
          "< $gf.pk >/dev/null 2>&1";


@@ -546,7 +549,7 @@ if ($user and $pubkey) {
       '$pk'
       '</pre>'
       '<p>'
       '$pk'
       '</pre>'
       '<p>'

-      '<a href="javascript:history.back()">back</a>'                                                     
+      '<a href="javascript:history.back()">back</a>'

       '</body></html>'
     ));
   }
       '</body></html>'
     ));
   }


@@ -555,7 +558,7 @@ if ($user and $pubkey) {
 
 if ($user and $encryption) {
   my $gf = "$user/\@GPG";
 
 if ($user and $encryption) {
   my $gf = "$user/\@GPG";

-  
+

   unless(-s "$ENV{HOME}/.gnupg/pubring.gpg") {
     html_error($error,"no GPG support activated");
   }
   unless(-s "$ENV{HOME}/.gnupg/pubring.gpg") {
     html_error($error,"no GPG support activated");
   }


@@ -567,7 +570,6 @@ if ($user and $encryption) {
       '<h3>E-mails to you will be sent not encrypted.</h3>'
       '<p>'
       '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
       '<h3>E-mails to you will be sent not encrypted.</h3>'
       '<p>'
       '<a href="/foc?akey=$akey">back to F*EX operation control</a>'

-      '</body></html>'

     ));
   } elsif ($encryption eq 'CHANGE') {
     pq(qq(
     ));
   } elsif ($encryption eq 'CHANGE') {
     pq(qq(


@@ -591,19 +593,19 @@ if ($user and $encryption) {
         '<pre>'
         '$g'
         '</pre>'
         '<pre>'
         '$g'
         '</pre>'

-        '<p><hr><p>'
-        '(*) To extract and verify your GPG public key use:'
-        '<pre>'
-        'gpg -a --export $user > pubkey.gpg'
-        'gpg < pubkey.gpg'
-        '</pre>'

       ));
     }
       ));
     }

-    print "</body></html>\n";
-    exit;
+    pq(qq(
+      '<p><hr><p>'
+      '(*) To extract and verify your GPG public key use:'
+      '<pre>'
+      'gpg -a --export $user > pubkey.gpg'
+      'gpg < pubkey.gpg'
+      '</pre>'
+    ));

   }
   }

-
-  &reexec;
+  print "</body></html>\n";
+  exit;

 }
 
 if ($user and $reminder eq 'yes') {
 }
 
 if ($user and $reminder eq 'yes') {


@@ -632,39 +634,39 @@ if ($user and $reminder eq 'no') {
 if ($nid) {
   $nid =~ s/^\s+//;
   $nid =~ s/\s+$//;
 if ($nid) {
   $nid =~ s/^\s+//;
   $nid =~ s/\s+$//;

-  
+

   $nid = randstring(6) if $nid eq '?';
   $nid = randstring(6) if $nid eq '?';

-  
+

   open $idf,'>',"$user/@" or die "$user/@ - $!\n";
   print {$idf} $nid,"\n";
   close $idf;
   $akey = untaint(md5_hex("$user:$nid"));
   unlink "$akeydir/$akey";
   symlink "../$user","$akeydir/$akey";
   open $idf,'>',"$user/@" or die "$user/@ - $!\n";
   print {$idf} $nid,"\n";
   close $idf;
   $akey = untaint(md5_hex("$user:$nid"));
   unlink "$akeydir/$akey";
   symlink "../$user","$akeydir/$akey";

-  
+

   pq(qq(
     '<h3>new auth-ID "<code>$nid</code>" for $user saved</h3>'
     '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
     '</body></html>'
   ));
   pq(qq(
     '<h3>new auth-ID "<code>$nid</code>" for $user saved</h3>'
     '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
     '</body></html>'
   ));

-  exit;
+  &reexec;

 }
 
 # empty subuser list POST
 }
 
 # empty subuser list POST

-if (defined(param('ssid')) and $ssid =~ /^\s*$/) {
+if (defined($PARAM{'ssid'}) and $ssid =~ /^\s*$/) {

   unlink "$user/\@SUBUSER";
   pq(qq(
     '<h2>All subusers deleted</h2>\n<ul>'
     '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
     '</body></html>'
   ));
   unlink "$user/\@SUBUSER";
   pq(qq(
     '<h2>All subusers deleted</h2>\n<ul>'
     '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
     '</body></html>'
   ));

-  exit;
+  &reexec;

 }
 
 # update sub-users
 if ($ssid) {
   my ($subuser,$subid,$skey);
 }
 
 # update sub-users
 if ($ssid) {
   my ($subuser,$subid,$skey);

-  
+

   # delete old skeys
   if (open $idf,'<',"$user/\@SUBUSER") {
     while (<$idf>) {
   # delete old skeys
   if (open $idf,'<',"$user/\@SUBUSER") {
     while (<$idf>) {


@@ -690,7 +692,7 @@ if ($ssid) {
       push @badaddress,$subuser unless checkaddress($subuser);
     }
   }
       push @badaddress,$subuser unless checkaddress($subuser);
     }
   }

-  
+

   if (@badaddress) {
     print "<h2>ERROR: bad addresses:</h2>\n<ul>";
     foreach my $ba (@badaddress) { print "<li>$ba" }
   if (@badaddress) {
     print "<h2>ERROR: bad addresses:</h2>\n<ul>";
     foreach my $ba (@badaddress) { print "<li>$ba" }


@@ -701,7 +703,7 @@ if ($ssid) {
     ));
     exit;
   }
     ));
     exit;
   }

-  
+

   if ($ssid =~ /\S\@\w/) {
     open $idf,'>',"$user/\@SUBUSER" or die "$user/\@SUBUSER - $!\n";
     print "Your subusers upload URLs are:<p><code>\n";
   if ($ssid =~ /\S\@\w/) {
     open $idf,'>',"$user/\@SUBUSER" or die "$user/\@SUBUSER - $!\n";
     print "Your subusers upload URLs are:<p><code>\n";


@@ -728,7 +730,7 @@ if ($ssid) {
     ));
   }
   print "<a href=\"/foc?akey=$akey\">back to F*EX operation control</a>\n";
     ));
   }
   print "<a href=\"/foc?akey=$akey\">back to F*EX operation control</a>\n";

-  print "</body></html>\n"; 
+  print "</body></html>\n";

   close $idf;
   exit;
 }
   close $idf;
   exit;
 }


@@ -831,9 +833,9 @@ sub notify_otuser {
   my ($user,$otuser,$url,$comment) = @_;
   my $server = $hostname || $mdomain;
   my $sf;
   my ($user,$otuser,$url,$comment) = @_;
   my $server = $hostname || $mdomain;
   my $sf;

-  
+

   return if $nomail;
   return if $nomail;

-  
+

   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
   $sf = $sender_from ? $sender_from : $user;
   open my $mail,'|-',$sendmail,'-f',$sf,$otuser,$bcc
   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
   $sf = $sender_from ? $sender_from : $user;
   open my $mail,'|-',$sendmail,'-f',$sf,$otuser,$bcc


@@ -865,9 +867,9 @@ sub notify_subuser {
   my ($user,$subuser,$url,$comment) = @_;
   my $server = $hostname || $mdomain;
   my $sf;
   my ($user,$subuser,$url,$comment) = @_;
   my $server = $hostname || $mdomain;
   my $sf;

-  
+

   return if $nomail;
   return if $nomail;

-  
+

   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
   $sf = $sender_from ? $sender_from : $user;
   open my $mail,'|-',$sendmail,'-f',$sf,$subuser,$user,$bcc
   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
   $sf = $sender_from ? $sender_from : $user;
   open my $mail,'|-',$sendmail,'-f',$sf,$subuser,$user,$bcc


@@ -903,7 +905,7 @@ sub notify_groupmember {
   my ($user,$gm,$group,$id,$url) = @_;
   my $server = $hostname || $mdomain;
   my $sf;
   my ($user,$gm,$group,$id,$url) = @_;
   my $server = $hostname || $mdomain;
   my $sf;

-  
+

   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
   $sf = $sender_from ? $sender_from : $user;
   open my $mail,'|-',$sendmail,'-f',$sf,$gm,$user,$bcc
   $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
   $sf = $sender_from ? $sender_from : $user;
   open my $mail,'|-',$sendmail,'-f',$sf,$gm,$user,$bcc


@@ -934,7 +936,7 @@ sub notify_groupmember {
 sub mkskey {
   my ($user,$subuser,$id) = @_;
   my $skey = md5_hex("$user:$subuser:$id");
 sub mkskey {
   my ($user,$subuser,$id) = @_;
   my $skey = md5_hex("$user:$subuser:$id");

-  
+

   open my $skf,'>',"$skeydir/$skey" or die "$skeydir/$skey - $!\n";
   print {$skf} "from=$subuser\n",
                "to=$user\n",
   open my $skf,'>',"$skeydir/$skey" or die "$skeydir/$skey - $!\n";
   print {$skf} "from=$subuser\n",
                "to=$user\n",


@@ -949,7 +951,7 @@ sub mkskey {
 sub mkgkey {
   my ($user,$group,$gm,$id) = @_;
   my $gkey = untaint(md5_hex("$user:$group:$gm:$id"));
 sub mkgkey {
   my ($user,$group,$gm,$id) = @_;
   my $gkey = untaint(md5_hex("$user:$group:$gm:$id"));

-  
+

   open my $gkf,'>',"$gkeydir/$gkey" or die "$gkeydir/$gkey - $!\n";
   print {$gkf} "from=$gm\n",
                "to=\@$group\n",
   open my $gkf,'>',"$gkeydir/$gkey" or die "$gkeydir/$gkey - $!\n";
   print {$gkf} "from=$gm\n",
                "to=\@$group\n",


@@ -962,7 +964,7 @@ sub mkgkey {
 
 sub handle_group {
   my ($gf,$gd,$gl,$gid,$gkey);
 
 sub handle_group {
   my ($gf,$gd,$gl,$gid,$gkey);

-  
+

   $group =~ s/^@+//;
   $group =~ s:[/&<>]::g;
 
   $group =~ s/^@+//;
   $group =~ s:[/&<>]::g;
 


@@ -1025,7 +1027,7 @@ sub handle_group {
   }
 
   $gf = untaint("$user/\@GROUP/$group");
   }
 
   $gf = untaint("$user/\@GROUP/$group");

-  
+

   if (defined $gm) {
     if ($gm =~ /\S/) {
       foreach (split /\n/,$gm) {
   if (defined $gm) {
     if ($gm =~ /\S/) {
       foreach (split /\n/,$gm) {


@@ -1053,7 +1055,7 @@ sub handle_group {
         foreach my $ba (@badaddress) { print "<li>$ba" }
         print "</ul>\n";
       }
         foreach my $ba (@badaddress) { print "<li>$ba" }
         print "</ul>\n";
       }

-      if (@badformat or @badaddress) {   
+      if (@badformat or @badaddress) {

         pq(qq(
           '<a href="javascript:history.back()">Go back</a>'
           '</body></html>'
         pq(qq(
           '<a href="javascript:history.back()">Go back</a>'
           '</body></html>'


@@ -1152,7 +1154,7 @@ sub handle_group {
         '<p>'
         '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
       ));
         '<p>'
         '<a href="/foc?akey=$akey">back to F*EX operation control</a>'
       ));

-      print end_html();
+      print "</body></html>\n";

       exit;
     } else {
       # no group members -> delete group file
       exit;
     } else {
       # no group members -> delete group file


@@ -1178,6 +1180,7 @@ sub handle_group {
         '  New group name: <input type="text" name="group"> (You MUST fill out this field!)'
         '  </font>'
       ));
         '  New group name: <input type="text" name="group"> (You MUST fill out this field!)'
         '  </font>'
       ));

+      $gm = $user.':'.randstring(8);

     } else {
       if (open $gf,'<',$gf) {
         local $/;
     } else {
       if (open $gf,'<',$gf) {
         local $/;