Original release 20160919

[fex.git] / cgi-bin / fur

diff --git a/cgi-bin/fur b/cgi-bin/fur
index 3d91f55878fba93e29eb35fa66341297cc0aba89..0ab7be9158057199d56d1e711e65491df656e65a 100755 (executable)
--- a/cgi-bin/fur
+++ b/cgi-bin/fur
@@ -5,12 +5,10 @@
 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
 #
 
 # Author: Ulli Horlacher <framstag@rus.uni-stuttgart.de>
 #
 

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

 
 

-$CGI::LIST_CONTEXT_WARN = 0;
-$CGI::LIST_CONTEXT_WARN = 0;
+use utf8;
+use Fcntl      qw(:flock :seek :mode);

 
 # import from fex.ph
 our (@local_hosts,@local_domains,@local_rhosts,@local_rdomains);
 
 # import from fex.ph
 our (@local_hosts,@local_domains,@local_rhosts,@local_rdomains);


@@ -18,7 +16,7 @@ our (@registration_hosts,@registration_domains);
 our ($usage_conditions);
 
 # import from fex.pp
 our ($usage_conditions);
 
 # import from fex.pp

-our ($mdomain,$logdir,$spooldir,$fra,$hostname,$sendmail,$admin,$bcc);
+our ($mdomain,@logdir,$spooldir,$fra,$hostname,$sendmail,$admin,$bcc);

 
 our $error = "F*EX user registration ERROR";
 
 
 our $error = "F*EX user registration ERROR";
 


@@ -33,7 +31,7 @@ die "$0: no $FEXLIB\n" unless -d $FEXLIB;
 # load common code, local config: $HOME/lib/fex.ph
 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
 
 # load common code, local config: $HOME/lib/fex.ph
 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
 

-my $log = "$logdir/fur.log";
+my $log = 'fur.log';

 my $head = "$ENV{SERVER_NAME} F*EX user registration";
 
 chdir $spooldir or die "$spooldir - $!\n";
 my $head = "$ENV{SERVER_NAME} F*EX user registration";
 
 chdir $spooldir or die "$spooldir - $!\n";


@@ -49,10 +47,21 @@ unless (@local_domains or @local_rdomains) {
   );
 }
 
   );
 }
 

+unless (@local_hosts and ipin($ra,@local_hosts) or
+        @local_rdomains and @local_rhosts and
+        (not @registration_hosts or ipin($ra,@registration_hosts))) {
+  html_error($error,
+    "Registrations from your host ($ra) are not allowed.",
+    "Contact $ENV{SERVER_ADMIN} for details."
+  );
+}
+

 # look for CGI parameters
 # look for CGI parameters

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

   $CASE =
     $v =~ /^user$/i    ? $user         = normalize_address($vv):
     $v =~ /^exuser$/i  ? $exuser       = normalize_address($vv):
   $CASE =
     $v =~ /^user$/i    ? $user         = normalize_address($vv):
     $v =~ /^exuser$/i  ? $exuser       = normalize_address($vv):


@@ -82,9 +91,9 @@ if ($confirm) {
   }
   # if (-f "$user/@") { http_die("$user is already activated") }
   open $user,'>',"$user/@" or http_die("open $user/@ - $!\n");
   }
   # if (-f "$user/@") { http_die("$user is already activated") }
   open $user,'>',"$user/@" or http_die("open $user/@ - $!\n");

-  print {$user} $id,"\n";  
+  print {$user} $id,"\n";

   close $user or http_die("close $user/@ - $!\n");
   close $user or http_die("close $user/@ - $!\n");

-  
+

   http_header("200 OK");
   print html_header($head);
   my $url = "$ENV{PROTO}://$ENV{HTTP_HOST}/fup/" . b64("from=$user&id=$id");
   http_header("200 OK");
   print html_header($head);
   my $url = "$ENV{PROTO}://$ENV{HTTP_HOST}/fup/" . b64("from=$user&id=$id");


@@ -97,11 +106,11 @@ if ($confirm) {
     '<p>'
     'or you can use:'
     '<p>'
     '<p>'
     'or you can use:'
     '<p>'

-    '<table>
+    '<table>'

     '  <tr><td>URL:<td><code><b>$ENV{PROTO}://$ENV{HTTP_HOST}/fup/</code></b></tr>'
     '  <tr><td>Sender:<td><code><b>$user</code></b></tr>'
     '  <tr><td>auth-ID:<td><code><b>$id</code></b></tr>'
     '  <tr><td>URL:<td><code><b>$ENV{PROTO}://$ENV{HTTP_HOST}/fup/</code></b></tr>'
     '  <tr><td>Sender:<td><code><b>$user</code></b></tr>'
     '  <tr><td>auth-ID:<td><code><b>$id</code></b></tr>'

-    '</table>
+    '</table>'

     '</body></html>'
   ));
   furlog("confirm: account $user created");
     '</body></html>'
   ));
   furlog("confirm: account $user created");


@@ -118,7 +127,7 @@ unless ($user or $exuser or $demouser) {
     '      accept-charset="UTF-8"'
     '      enctype="multipart/form-data">'
   ));
     '      accept-charset="UTF-8"'
     '      enctype="multipart/form-data">'
   ));

-  
+

   if (@local_domains and @local_hosts and ipin($ra,@local_hosts)) {
     $reg = $ra;
     if (grep(/\*/,@local_domains)) {
   if (@local_domains and @local_hosts and ipin($ra,@local_hosts)) {
     $reg = $ra;
     if (grep(/\*/,@local_domains)) {


@@ -144,8 +153,8 @@ unless ($user or $exuser or $demouser) {
       ));
     }
   }
       ));
     }
   }

-  
-  if (@local_rdomains and @local_rhosts and 
+
+  if (@local_rdomains and @local_rhosts and

       (not @registration_hosts or ipin($ra,@registration_hosts))) {
     print "   <p>or<p>\n" if $reg;
     $reg = $ra;
       (not @registration_hosts or ipin($ra,@registration_hosts))) {
     print "   <p>or<p>\n" if $reg;
     $reg = $ra;


@@ -155,7 +164,7 @@ unless ($user or $exuser or $demouser) {
       '  <p>'
     ));
   }
       '  <p>'
     ));
   }

-  
+

   if (@demo) {
     print "   <p>or<p>\n" if $reg;
     $reg = $ra;
   if (@demo) {
     print "   <p>or<p>\n" if $reg;
     $reg = $ra;


@@ -167,7 +176,7 @@ unless ($user or $exuser or $demouser) {
       '  <p>'
     ));
   }
       '  <p>'
     ));
   }

-  
+

   if ($reg) {
     pq(qq(
       '  <p>'
   if ($reg) {
     pq(qq(
       '  <p>'


@@ -188,7 +197,7 @@ unless ($user or $exuser or $demouser) {
     pq(qq(
       '</pre>'
       '<p><hr><p>'
     pq(qq(
       '</pre>'
       '<p><hr><p>'

-      '<a href="http://fex.rus.uni-stuttgart.de/users.html">User types overview</a>'
+      '<a href="/users.html">User types overview</a>'

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


@@ -238,7 +247,7 @@ if ($exuser) {
   $mydomains .= "|$mdomain" if $mdomain;
   $user .= '@'.$domain if $domain and $user !~ /@/;
   # $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
   $mydomains .= "|$mdomain" if $mdomain;
   $user .= '@'.$domain if $domain and $user !~ /@/;
   # $user .= '@'.$mdomain if $mdomain and $user !~ /@/;

-  
+

   unless (@local_hosts and ipin($ra,@local_hosts)) {
     html_error($error,
       "Registrations from your host ($ra) are not allowed.",
   unless (@local_hosts and ipin($ra,@local_hosts)) {
     html_error($error,
       "Registrations from your host ($ra) are not allowed.",


@@ -268,7 +277,7 @@ if (-f "$user/@") {
     $error,
     "you are already registered".
     " (<a href=\"/fup?from=$user&ID_forgotten=1\">I have lost my auth-ID</a>)"
     $error,
     "you are already registered".
     " (<a href=\"/fup?from=$user&ID_forgotten=1\">I have lost my auth-ID</a>)"

-  ); 
+  );

 }
 
 unless (-d $user) {
 }
 
 unless (-d $user) {


@@ -289,7 +298,7 @@ if ($exuser) {
   print {$rf} "\@LOCAL_RHOSTS\n";
   close $rf;
   if (open $user,'>',"$user/.auto") {
   print {$rf} "\@LOCAL_RHOSTS\n";
   close $rf;
   if (open $user,'>',"$user/.auto") {

-    print {$user} "fur:external\n";  
+    print {$user} "fur:external\n";

     close $user;
   }
 } elsif ($demouser) {
     close $user;
   }
 } elsif ($demouser) {


@@ -299,13 +308,13 @@ if ($exuser) {
   printf {$quota} "sender:%d\n",$demo[0];
   close $quota;
   if (open $user,'>',"$user/.auto") {
   printf {$quota} "sender:%d\n",$demo[0];
   close $quota;
   if (open $user,'>',"$user/.auto") {

-    print {$user} "fur:demo\n";  
+    print {$user} "fur:demo\n";

     close $user;
   }
   open $demouser,'>',"$demouser/.demo" and close $demouser;
 } else {
   if (open $user,'>',"$user/.auto") {
     close $user;
   }
   open $demouser,'>',"$demouser/.demo" and close $demouser;
 } else {
   if (open $user,'>',"$user/.auto") {

-    print {$user} "fur:internal\n";  
+    print {$user} "fur:internal\n";

     close $user;
   }
 }
     close $user;
   }
 }


@@ -314,7 +323,7 @@ $id = randstring(6);
 
 if ("@local_domains" eq "*") {
   open $id,'>',"$user/@" or http_die("open $user/@ - $!\n");
 
 if ("@local_domains" eq "*") {
   open $id,'>',"$user/@" or http_die("open $user/@ - $!\n");

-  print {$id} $id,"\n";  
+  print {$id} $id,"\n";

   close $id or http_die("close $user/@ - $!\n");
   http_header("200 OK");
   print html_header($head);
   close $id or http_die("close $user/@ - $!\n");
   http_header("200 OK");
   print html_header($head);


@@ -334,12 +343,12 @@ if ("@local_domains" eq "*") {
 # from fexsend
 if ($verify eq 'no') {
   open $id,'>',"$user/@" or http_die("open $user/@ - $!\n");
 # from fexsend
 if ($verify eq 'no') {
   open $id,'>',"$user/@" or http_die("open $user/@ - $!\n");

-  print {$id} $id,"\n";  
+  print {$id} $id,"\n";

   close $id or http_die("close $user/@ - $!\n");
   http_header("200 OK",'Content-Type: text/plain');
   print "$ENV{PROTO}://$ENV{HTTP_HOST}/fup?from=$user&ID=$id\n";
   furlog("direct: account $user created");
   close $id or http_die("close $user/@ - $!\n");
   http_header("200 OK",'Content-Type: text/plain');
   print "$ENV{PROTO}://$ENV{HTTP_HOST}/fup?from=$user&ID=$id\n";
   furlog("direct: account $user created");

-  if ($bcc and open my $mail,"|$sendmail '$bcc' 2>>$log") {
+  if ($bcc and open my $mail,"|$sendmail '$bcc' 2>>$logdir[0]/$log") {

     pq($mail,qq(
       'From: fex'
       'To: $bcc'
     pq($mail,qq(
       'From: fex'
       'To: $bcc'


@@ -384,7 +393,7 @@ close $mail or http_die("cannot send mail - $!\n");
 http_header("200 OK");
 print html_header($head);
 print "confirmation e-mail has been sent to <code>$user</code>\n";
 http_header("200 OK");
 print html_header($head);
 print "confirmation e-mail has been sent to <code>$user</code>\n";

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

 furlog("confirmation request mailed to $user");
 exit;
 
 furlog("confirmation request mailed to $user");
 exit;
 


@@ -392,17 +401,13 @@ exit;
 # standard log
 sub furlog {
   my $msg = "@_";
 # standard log
 sub furlog {
   my $msg = "@_";

-  
+

   $msg =~ s/\n/ /g;
   $msg =~ s/\s+$//;
   $msg =~ s/\n/ /g;
   $msg =~ s/\s+$//;

-  
-  if (open $log,'>>',$log) {
-    flock $log,LOCK_EX;
-    seek $log,0,SEEK_END;
-    printf {$log} "%s [%s_%s] %s %s\n",
-                  isodate(time),$$,$ENV{REQUESTCOUNT},$fra,$msg;
-    close $log;
-  }
+  $msg = sprintf "%s [%s_%s] %s %s\n",
+                 isodate(time),$$,$ENV{REQUESTCOUNT},$fra,$msg;
+
+  writelog($log,$msg);

 }
 
 sub normalize_address {
 }
 
 sub normalize_address {