Original release 20160919

[fex.git] / cgi-bin / fuc

diff --git a/cgi-bin/fuc b/cgi-bin/fuc
index c18aa454fddb2f9b003cfdb0293c4ca8cf22d037..897fd69a719aea0972630ac725462595a5808a6b 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>


@@ -8,6 +8,7 @@
 
 BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
 
 
 BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
 

+use utf8;

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


@@ -74,7 +75,7 @@ foreach my $v (keys %PARAM) {
     $v =~ /^group$/i           ? $group        = checkchars('group',$vv):
     $v =~ /^ab$/i              ? $ab           = $vv:
     $v =~ /^gm$/i              ? $gm           = $vv:
     $v =~ /^group$/i           ? $group        = checkchars('group',$vv):
     $v =~ /^ab$/i              ? $ab           = $vv:
     $v =~ /^gm$/i              ? $gm           = $vv:

-    $v =~ /^show$/i            ? $tools        = checkchars('parameter',$vv):
+    $v =~ /^show$/i            ? $show         = checkchars('parameter',$vv):

   $ESAC;
 }
 
   $ESAC;
 }
 


@@ -87,15 +88,39 @@ $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 
 $nomail = $comment if $comment =~ /NOMAIL|!#!/;
 
 
 $nomail = $comment if $comment =~ /NOMAIL|!#!/;
 

+if ($show and $show eq 'tools') {
+  nvt_print(
+    "HTTP/1.1 302 Found",
+    "Location: /tools.html",
+    'Expires: 0',
+    'Content-Length: 0',
+    ''
+  );
+  &reexec;
+
+  if (open $tools,"$docdir/tools.html") {
+    while (<$tools>) {
+      while (/\$([\w_]+)\$/) {
+        my $var = $1;
+        my $env = $ENV{$var} || '';
+        s/\$$var\$/$env/g;
+      };
+      print;
+    }
+  }
+  exit;
+}
+
+

 if ($akey) {
 
   # sid is not set with web browser
   my $idf = "$akeydir/$akey/@";
 if ($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);


@@ -110,7 +135,7 @@ if ($akey) {
 if ($user and $akey and $qs and $qs =~ /info=(.+?)&skey=(.+)/) {
   $subuser = $1;
   $skey = $2;
 if ($user and $akey and $qs and $qs =~ /info=(.+?)&skey=(.+)/) {
   $subuser = $1;
   $skey = $2;

-  notify_subuser($user,$subuser,"$fup?skey=$skey",$comment);
+  notify_subuser($user,$subuser,"$fup?skey=$skey#$user",$comment);

   http_header("200 OK");
   print html_header($head);
   pq(qq(
   http_header("200 OK");
   print html_header($head);
   pq(qq(


@@ -123,7 +148,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 +178,9 @@ if ($user and $id) {
 }
 
 # empty POST? ==> back to foc
 }
 
 # empty POST? ==> back to foc

-if ($ENV{REQUEST_METHOD} eq 'POST' and not 
-    ($subuser or $notify or $nid or $ssid or $group or $ab or $gm or $tools
-     or $disclaimer or $encryption or $pubkey)) 
+if ($ENV{REQUEST_METHOD} eq 'POST' and not
+    ($subuser or $notify or $nid or $ssid or $group or $ab or $gm
+     or $disclaimer or $encryption or $pubkey))

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


@@ -181,31 +206,6 @@ if ($gm and not $group) {
   exit;
 }
 
   exit;
 }
 

-if ($tools) {
-  pq(qq(
-    'To use one of the following F*EX clients you must configure them after'
-    'download:'
-    '<p>'
-    '<table border=1>'
-    '  <tr><th align=left>F*EX server:<td><code>$ENV{PROTO}://$ENV{HTTP_HOST}</code></tr>'
-    '  <tr><th align=left>Proxy:<td>(your web proxy address, may be empty)</tr>'
-    '  <tr><th align=left>User:<td><code>$user</code></tr>'
-    '  <tr><th align=left>Auth-ID:<td><code>$id</code></tr>'
-    '</table>'
-  ));
-  if (open $tools,"$docdir/tools.html") {
-    while (<$tools>) {
-      while (/\$([\w_]+)\$/) {
-        my $var = $1;
-        my $env = $ENV{$var} || '';
-        s/\$$var\$/$env/g;
-      };
-      print;
-    }
-  }
-  exit;
-}
-

 if ($group) {
   &handle_group;
 }
 if ($group) {
   &handle_group;
 }


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


@@ -845,6 +845,8 @@ sub notify_otuser {
     'To: $otuser'
     'Subject: Your upload URL'
     'X-Mailer: F*EX'
     'To: $otuser'
     'Subject: Your upload URL'
     'X-Mailer: F*EX'

+    'Content-Type: text/plain; charset=utf-8'
+    'Content-Transfer-Encoding: 8bit'

     ''
     'This is an automatically generated e-mail.'
     ''
     ''
     'This is an automatically generated e-mail.'
     ''


@@ -867,9 +869,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


@@ -880,6 +882,8 @@ sub notify_subuser {
     'Cc: $user'
     'Subject: Your F*EX account on $server'
     'X-Mailer: F*EX'
     'Cc: $user'
     'Subject: Your F*EX account on $server'
     'X-Mailer: F*EX'

+    'Content-Type: text/plain; charset=utf-8'
+    'Content-Transfer-Encoding: 8bit'

     ''
     'This is an automatically generated e-mail.'
     ''
     ''
     'This is an automatically generated e-mail.'
     ''


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


@@ -924,7 +928,7 @@ sub notify_groupmember {
     ''
     'to upload files to F*EX group "$group"'
     ''
     ''
     'to upload files to F*EX group "$group"'
     ''

-    'See http://$ENV{HTTP_HOST}/ for more information about F*EX.'
+    'See http://$ENV{HTTP_HOST}/index.html for more information about F*EX.'

     ''
     'Questions? ==> F*EX admin: $admin'
   ));
     ''
     'Questions? ==> F*EX admin: $admin'
   ));


@@ -936,7 +940,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 +955,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 +968,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 +1031,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 +1059,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>'