Original release 20160919

[fex.git] / cgi-bin / fuc

diff --git a/cgi-bin/fuc b/cgi-bin/fuc
index 864a3de5966ab1c1b5ef971a323260697531e385..897fd69a719aea0972630ac725462595a5808a6b 100755 (executable)
--- a/cgi-bin/fuc
+++ b/cgi-bin/fuc
@@ -1,19 +1,17 @@
 #!/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 utf8;

 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 +47,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 +65,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)):


@@ -75,25 +75,52 @@ foreach my $v (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;
 }
 

-$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 !~ /@/;
 
 $nomail = $comment if $comment =~ /NOMAIL|!#!/;
 
 $group = '' if $nomail;
 $user .= '@'.$mdomain if $mdomain and $user !~ /@/;
 
 $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);


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


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


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


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


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


@@ -843,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.'
     ''


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


@@ -878,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.'
     ''


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


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


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


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


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


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


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


@@ -1152,7 +1158,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 +1184,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 $/;