Original release 20150826

[fex.git] / cgi-bin / fuc

diff --git a/cgi-bin/fuc b/cgi-bin/fuc
index c18aa454fddb2f9b003cfdb0293c4ca8cf22d037..661c897367a7418beabb0ec97bf7b57a693a3a3f 100755 (executable)
--- a/cgi-bin/fuc
+++ b/cgi-bin/fuc
@@ -1,6 +1,6 @@
 #!/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>


@@ -91,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);


@@ -123,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");


@@ -153,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",


@@ -224,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(


@@ -359,7 +359,7 @@ if ($user and $akey and defined $ab) {
   } 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+$//;


@@ -379,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" }


@@ -393,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;


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

-  
+

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


@@ -558,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");
   }


@@ -634,16 +634,16 @@ 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>'
   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>'


@@ -666,7 +666,7 @@ if (defined($PARAM{'ssid'}) and $ssid =~ /^\s*$/) {
 # 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>) {


@@ -692,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" }


@@ -703,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";


@@ -730,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;
 }


@@ -833,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


@@ -867,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


@@ -905,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


@@ -936,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",


@@ -951,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",


@@ -964,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;
 


@@ -1027,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) {


@@ -1055,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>'