cgi-bin/fac

   1 #!/usr/bin/perl -Tw
   2
   3 # F*EX CGI for administration
   4 #
   5 # Original author: Andre Hafner <andrehafner@gmx.net>
   6 #
   7
   8 BEGIN { ($ENV{PERLINIT}||'') =~ /(.+)/s and eval $1 }
   9
  10 $| = 1;
  11
  12 $fac = $0;
  13 $fac =~ s:.*/::;
  14
  15 # add fex lib
  16 (our $FEXLIB) = $ENV{FEXLIB} =~ /(.+)/ or die "no \$FEXLIB\n";
  17
  18 # import from fex.pp and fex.ph
  19 our ($FEXHOME,$spooldir,$logdir,$docdir,$akeydir,$durl,$mdomain,$bs,$hostname);
  20 our ($keep_default,$keep_max,$recipient_quota,$sender_quota,$autodelete);
  21 our ($admin,$admin_pw,$admin_hosts);
  22 our ($sendmail,$bcc);
  23 our $error = 'FAC error';
  24
  25 # load common code, local config : $HOME/lib/fex.ph
  26 require "$FEXLIB/fex.pp";
  27
  28 my @http_auth = ();
  29 my $ra = $ENV{REMOTE_ADDR}||0;
  30
  31 if (not @admin_hosts or not ipin($ra,@admin_hosts)) {
  32   html_error($error,"Administration from your host ($ra) is not allowed.");
  33 }
  34
  35 html_error($error,"\$admin not configured in $FEXLIB/fex.ph\n") unless $admin;
  36
  37 chdir $spooldir or http_die("$spooldir - $!");
  38 chomp($admin_pw = slurp("$admin/@")||'');
  39 html_error($error,"no F*EX account for admin $admin\n") unless $admin_pw;
  40
  41 # redirect to https if configured
  42 (undef,$port) = split(':',$ENV{HTTP_HOST}||'');
  43 $port ||= $ENV{PROTO} eq 'https' ? 443 : 80;
  44 if ($port == 80 and open my $x,'/etc/xinetd.d/fexs') {
  45   while (<$x>) {
  46     if (/^\s*disable\s*=\s*no/) {
  47       nvt_print(
  48         "HTTP/1.1 301 Moved Permanently",
  49         "Location: https://$hostname$ENV{REQUEST_URI}",
  50         'Content-Length: 0',
  51         ''
  52       );
  53       exit;
  54     }
  55   }
  56   close $x;
  57 }
  58
  59 our %PARAM;
  60 &parse_parameters;
  61
  62 $action = $PARAM{"action"}||'';
  63
  64 # authentication
  65 &require_akey;
  66
  67 my $fup = $durl;
  68 $fup =~ s:/fop:/fup:;
  69
  70 my $http_client = $ENV{HTTP_USER_AGENT} || '';
  71
  72 # files to save with backup function
  73 my @backup_files = qw(
  74   htdocs/index.html
  75   lib/fex.ph
  76   lib/fup.pl
  77   spool/*@*/@*
  78   spool/*@*/.auto
  79 );
  80
  81 # backup goes first
  82 if ($action eq "backup") {
  83   &backup;
  84   exit;
  85 }
  86
  87 http_header('200 OK');
  88
  89 $_ = html_header("F*EX Admin Control for $hostname");
  90 s:</h1>: (<a href="?action=logout">logout</a>)</h1>:;
  91 print;
  92
  93 my $nav_user =
  94   "<li><a href=\"?action=create\">Create new user</a>\n".
  95   "<li><a href=\"?action=change-auth\">Change user auth-ID</a>\n".
  96   "<li><a href=\"?action=edit\">Edit user restrictions file</a>\n".
  97   "<li><a href=\"?action=delete\">Delete existing user</a>\n".
  98   "<li><a href=\"?action=quota\">Manage disk quota</a>\n";
  99
 100 my $nav_log =
 101   "<li><a href=\"?action=fup.log\">Get fup.log</a>\n".
 102   "<li><a href=\"?action=fop.log\">Get fop.log</a>\n".
 103   "<li><a href=\"?action=error.log\">Get error.log</a>\n";
 104
 105 if (-f "$logdir/fexsrv.log") {
 106   $nav_log =
 107     "<li><a href=\"?action=watch\">Watch logfile</a>\n".
 108     "<li><a href=\"?action=fexsrv.log\">Get fexsrv.log</a>\n".
 109     $nav_log;
 110 }
 111
 112 my $nav_backup =
 113   "<li><a href=\"?action=backup\">Download backup<br>(config only)</a>\n".
 114   "<li><a href=\"?action=restore\">Restore backup</a>\n";
 115
 116 my $nav_show =
 117   "<li><a href=\"?action=list\">List spooled files</a>\n".
 118   "<li><a href=\"?action=showquota\">Show quotas (sender/recipient)</a>\n".
 119   "<li><a href=\"?action=showconfig\">Show server config</a>\n".
 120   "<li><a href=\"?action=userconfig\">Show user config</a>\n";
 121
 122 my $nav_edit =
 123   "<li><a href=\"?action=editconfig\">Edit config</a>\n".
 124   "<li><a href=\"?action=editindex\">Edit index.html</a>\n";
 125
 126 pq(qq(
 127   '<table border="0">'
 128   '  <th>manage user</th>'
 129   '  <th>show</th>'
 130   '  <th>log files</th>'
 131   '  <th>edit</th>'
 132   '  <th>backup</th>'
 133   '  <tr valign="top">'
 134   '    <td><ul>$nav_user</ul>'
 135   '    <td><ul>$nav_show</ul>'
 136   '    <td><ul>$nav_log</ul>'
 137   '    <td><ul>$nav_edit</ul>'
 138   '    <td><ul>$nav_backup</ul>'
 139   '  </tr>'
 140   '</table>'
 141   '<hr>'
 142 ));
 143
 144 my @user_items = &userList;
 145
 146 if    ($action eq "create")      { &createUserForm }
 147 elsif ($action eq "change-auth") { &changeAuthForm }
 148 elsif ($action eq "edit")        { &editRestrictionsForm }
 149 elsif ($action eq "delete")      { &deleteUserForm }
 150 elsif ($action eq "quota")       { &changeQuotaForm }
 151 elsif ($action eq "list")        { &listFiles }
 152 elsif ($action eq "showquota")   { &showQuota }
 153 elsif ($action eq "showconfig")  { &showConfig }
 154 elsif ($action eq "userconfig")  { &userConfigForm }
 155 elsif ($action eq "watch")       { &watchLog }
 156 elsif ($action eq "fexsrv.log")  { &getlog("fexsrv.log") }
 157 elsif ($action eq "fup.log")     { &getlog("fup.log") }
 158 elsif ($action eq "fop.log")     { &getlog("fop.log") }
 159 elsif ($action eq "error.log")   { &getlog("error.log") }
 160 elsif ($action eq "editconfig")  { &editFile("$FEXLIB/fex.ph") }
 161 elsif ($action eq "editindex")   { &editFile("$docdir/index.html") }
 162 elsif ($action eq "backup")      { &backup }
 163 elsif ($action eq "restore")     { &restoreForm }
 164
 165 if (defined $PARAM{"createUser"}) {
 166   createUser($PARAM{"createUser"}, $PARAM{"authID"});
 167 } elsif (defined $PARAM{"changeAuthUser"}) {
 168   if ($PARAM{"changeAuthUser"} =~ /^#.*/) {
 169     &changeAuthForm;
 170   } else {
 171     changeUser($PARAM{"changeAuthUser"}, $PARAM{"authID"});
 172   }
 173 } elsif (defined $PARAM{"showUserConfig"}) {
 174   if ($PARAM{"showUserConfig"} =~ /^#.*/) {
 175     &userConfigForm;
 176   } else {
 177     showUserConfig($PARAM{"showUserConfig"});
 178   }
 179 } elsif (defined $PARAM{"deleteUser"}) {
 180   if ($PARAM{"deleteUser"} =~ /^#.*/) {
 181     &deleteUserForm;
 182   } else {
 183     deleteUser($PARAM{"deleteUser"});
 184   }
 185 } elsif (defined $PARAM{"userQuota"}) {
 186   if ($PARAM{"userQuota"} =~ /^#.*/) {
 187     &changeQuotaForm;
 188   } else {
 189     if (defined $PARAM{"default quota"}) {
 190       $user = normalize_user($PARAM{"userQuota"});
 191       unlink "$user/\@QUOTA";
 192       print "$user has now default quota:<p>\n";
 193       print "recipient quota: $recipient_quota MB<br>\n";
 194       print "sender quota: $sender_quota MB<br>\n";
 195       &end_html;
 196     } else {
 197       alterQuota(
 198         $PARAM{"userQuota"},
 199         $PARAM{"recipientQuota"},
 200         $PARAM{"senderQuota"}
 201       );
 202     }
 203   }
 204 } elsif (defined $PARAM{"editUser"}) {
 205   if ($PARAM{"editUser"} =~ /^#.*/) {
 206     &editRestrictionsForm;
 207   } else {
 208     if (defined $PARAM{"delete file"}) {
 209       $user = normalize_user($PARAM{"editUser"});
 210       unlink "$user/\@ALLOWED_RECIPIENTS";
 211       print "upload restrictions for $user have been deleted\n";
 212       &end_html;
 213     } else {
 214       editUser($PARAM{"editUser"});
 215     }
 216   }
 217 } elsif ($PARAM{"contentBox"} and $PARAM{"ar"}) {
 218   saveFile($PARAM{"contentBox"},$PARAM{"ar"});
 219 } elsif ($PARAM{"upload_archive"}) {
 220   restore($PARAM{"upload_archive"}{data});
 221 }
 222
 223 &end_html;
 224
 225 #######
 226 # declaration of formular functions
 227 #######
 228
 229 # formular for creating new users
 230 # required arguments: -
 231 sub createUserForm {
 232   print h3("Create new user");
 233   pq(qq(
 234     '<form action="/$fac" method="post" enctype="multipart/form-data">'
 235     '<table>'
 236     '<tr>'
 237     '<td>user</td><td><input type="text" name="createUser" size="80"></td>'
 238     '</tr>'
 239     '<tr>'
 240     '<td>auth-ID:</td><td><input type="text" name="authID" size="16"></td>'
 241     '</tr>'
 242     '</table>'
 243     '<input type="submit" name="create user" value="create user">'
 244     '</form>'
 245   ));
 246   &end_html;
 247 }
 248
 249 # formular for changing auth-id of an user
 250 # required arguments: -
 251 sub changeAuthForm {
 252   my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
 253
 254   print h3("change auth-ID");
 255   pq(qq(
 256     '<form action="/$fac" method="post" enctype="multipart/form-data">'
 257     '<table>'
 258     '<tr>'
 259     '<td>user:</td><td><select name="changeAuthUser">@option</select></td>'
 260     '</tr>'
 261     '<tr>'
 262     '<td>new auth-ID:</td><td><input type="text" name="authID" size="16"></td>'
 263     '</tr>'
 264     '</table>'
 265     '<input type="submit" name="change" value="change">'
 266     '</form>'
 267   ));
 268   &end_html;
 269 }
 270
 271 # formular choosing user, whose config files shall be shown
 272 # required arguments: -
 273 sub userConfigForm {
 274   my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
 275
 276   print h3("Show user config files");
 277   pq(qq(
 278     '<form action="/$fac" method="post enctype="multipart/form-data">'
 279     '<table>'
 280     '<tr>'
 281     '<td>user:</td><td><select name="showUserConfig">@option</select></td>'
 282     '</tr>'
 283     '</table>'
 284     '<input type="submit" name="show config files" value="show config files">'
 285     '</form>'
 286   ));
 287   &end_html;
 288 }
 289
 290 # formular for choosing user, whose restriction file shall be edited
 291 # required arguments: -
 292 sub editRestrictionsForm {
 293   my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
 294
 295   print h3("Edit user restriction file");
 296   pq(qq(
 297     '<form action="/$fac" method="post enctype="multipart/form-data">'
 298     '<table>'
 299     '<tr>'
 300     '<td>user:</td><td><select name="editUser">@option</select></td>'
 301     '</tr>'
 302     '</table>'
 303     '<input type="submit" name="edit file" value="edit file">'
 304     '<input type="submit" name="delete file" value="delete file">'
 305     '</form>'
 306   ));
 307   &end_html;
 308 }
 309
 310 # formular for choosing user, who shall be removed
 311 # required arguments: -
 312 sub deleteUserForm {
 313   my @option = map { "<option value=\"$_\">$_</option>\n" } @user_items;
 314
 315   print h3("Delete existing user");
 316   pq(qq(
 317     '<form action="/$fac" method="post enctype="multipart/form-data">'
 318     '<table>'
 319     '<tr>'
 320     '<td>user:</td><td><select name="deleteUser">@option</select></td>'
 321     '</tr>'
 322     '</table>'
 323     '<input type="submit" name="delete user" value="delete user">'
 324     '</form>'
 325   ));
 326   &end_html;
 327 }
 328
 329 # formular for changing an user's quota file
 330 # required arguments: -
 331 sub changeQuotaForm {
 332   my $user;
 333   my @option;
 334   my $rquota = '';
 335   my $squota = '';
 336
 337   if ($user = $PARAM{"user"}) {
 338
 339     $user = normalize_user($user);
 340     $rquota = $1 if ($PARAM{"rquota"}||'') =~ /^(\d+)$/;
 341     $squota = $1 if ($PARAM{"squota"}||'') =~ /^(\d+)$/;
 342   }
 343
 344   foreach (@user_items) {
 345     if ($user and $user eq $_) {
 346       push @option,"<option value=\"$_\" selected>$_</option>\n";
 347     } else {
 348       push @option,"<option value=\"$_\">$_</option>\n";
 349     }
 350   }
 351
 352   print h3("Manage disk quota");
 353   pq(qq(
 354     '<form action="/$fac" method="post" enctype="multipart/form-data">'
 355     '<table>'
 356     '<tr>'
 357     '<td>user:</td><td><select name="userQuota">@option</select></td>'
 358     '</tr>'
 359     '<tr>'
 360     '<td>new quota for recipient:</td>'
 361     '<td><input type="text" name="recipientQuota" size="12" value=\"$rquota\">'
 362     ' MB (optional)</td>'
 363     '</tr>'
 364     '<tr>'
 365     '<td>new quota for sender:</td>'
 366     '<td><input type="text" name="senderQuota" size="12" value=\"$squota\">'
 367     ' MB (optional)</td>'
 368     '</tr>'
 369     '</table>'
 370     '<input type="submit" name="change quota" value="change quota">'
 371     '<input type="submit" name="default quota" value="default quota">'
 372     '</form>'
 373   ));
 374   &end_html;
 375 }
 376
 377 # formular for choosing backup file to restore
 378 # required arguments: -
 379 sub restoreForm {
 380   print h2("restore config");
 381   pq(qq(
 382     'Specify the backup-archive you want to restore:<br>'
 383     '<form action="/$fac" method="post" enctype="multipart/form-data">'
 384     '<input type="file" name="upload_archive" size="80"><br>'
 385     '<input type="submit" name="restore" value="restore">'
 386     '</form>'
 387   ));
 388   &end_html;
 389 }
 390
 391
 392 #######
 393 # declaration user functions
 394 #######
 395
 396 # function for creating new users
 397 # required arguments: username, auth-id
 398 sub createUser {
 399   my ($user,$id) = @_;
 400   my $idf;
 401
 402   http_die("not enough arguments in createUser") unless $id;
 403
 404   $user = normalize_user($user);
 405
 406   unless (-d "$user") {
 407     mkdir "$user",0755 or http_die("cannot mkdir $user - $!");
 408   }
 409
 410   $idf = "$user/@";
 411
 412   if (-f $idf) {
 413     html_error($error,"There is already an user $user!");
 414   }
 415
 416   open $idf,'>',$idf or http_die("cannot write $idf - $!");
 417   print {$idf} $id,"\n";
 418   close $idf or http_die("cannot write $idf - $!");
 419   print "<code>\n";
 420   printf "%s?from=%s&ID=%s<br>\n",$fup,$user,$id;
 421   printf "%s/%s<p>\n",$fup,b64("from=$user&id=$id");
 422   print "</code>\n";
 423   notifyUser($user,$id);
 424   print "An information e-mail to $user has been sent.\n";
 425   &end_html;
 426 }
 427
 428 # function for changing an user's auth-ID
 429 # required arguments: username, auth-id
 430 sub changeUser {
 431   my ($user,$id) = @_;
 432
 433   http_die("not enough arguments in changeUser") unless $id;
 434
 435   $id = despace($id);
 436   $user = normalize_user($user);
 437   my $idf = "$user/@";
 438   print "<code>\n";
 439   print "$idf<p>";
 440
 441   open $idf,'>',$idf or http_die("cannot write $idf - $!");
 442   print {$idf} $id,"\n";
 443   close $idf or http_die("cannot write $idf - $!");
 444   printf "%s?from=%s&ID=%s<br>\n",$fup,$user,$id;
 445   printf "%s/%s\n",$fup,b64("from=$user&id=$id");
 446   print "</code><p>\n";
 447   notifyUser($user,$id,"change-auth");
 448   print "An information e-mail to $user has been sent.\n";
 449   &end_html;
 450 }
 451
 452 # function for showing an user's config files
 453 # required arguments: username
 454 sub showUserConfig {
 455   my $user = shift;
 456
 457   http_die("not enough arguments in showUserConfig!") unless $user;
 458   $user = normalize_user($user);
 459
 460   chdir "$user" or http_die("could not change directory $user - $!");
 461   print h2("Config files of <code>$user</code>");
 462
 463   foreach my $file (glob('.auto @* @GROUP/*')) {
 464     if (-f $file and not -l $file and $file !~ /.*~$/) {
 465       print h3($file), "\n";
 466       open $file,'<',$file or http_die("cannot open $file - $!");
 467       # print "<table border=1><tr><td>\n";
 468       dumpfile($file);
 469       # print "</tr></table>\n";
 470       close $file;
 471     }
 472   }
 473   &end_html;
 474 }
 475
 476 # function for editing an user's recipient/sender restrictions
 477 # required arguments: username
 478 sub editUser {
 479   my $user = shift;
 480   my $content;
 481
 482   http_die("not enough arguments in editUser") unless $user;
 483   $user = normalize_user($user);
 484   http_die("no user $user") unless -d $user;
 485   my $ar = "$user/\@ALLOWED_RECIPIENTS";
 486   unless (-f $ar) {
 487     open $ar,'>',$ar or http_die("cannot open $ar - $!");
 488     print {$ar}<<'EOD';
 489 # Restrict allowed recipients. Only those listed here are allowed.
 490 # Make this file COMPLETLY empty if you want to disable the restriction.
 491 # An allowed recipient is an e-mail address, you can use * as wildcard.
 492 # Example: *@flupp.org
 493 EOD
 494     close $ar;
 495   }
 496   $content = dehtml(slurp($ar));
 497   pq(qq(
 498     'Edit restrictions file for user $user :<br>'
 499     '<form action="/$fac" method="post" enctype="multipart/form-data">'
 500     '<textarea name="contentBox"  rows="10" cols="80">'
 501     '$content'
 502     '</textarea><br>'
 503     '<input type="hidden" name="ar" value="$ar">'
 504     '<input type="submit" name="save changes" value="save changes">'
 505     '</form>'
 506   ));
 507   &end_html;
 508 }
 509
 510 # function for deleting files
 511 # required arguments: list of Files
 512 sub deleteFiles {
 513   http_die("not enough arguments in deleteFiles") unless (my @files = @_);
 514
 515   foreach (@files) {
 516     if (-e) {
 517       if (unlink $_) {
 518         print "file has been deleted: $_<br>\n";
 519       } else {
 520         print "file could not be deleted: $_ - $!<br>\n";
 521       }
 522     } else {
 523       print "file does not exists: $_<br>\n";
 524     }
 525   }
 526   &end_html;
 527 }
 528
 529 # function for saving a single file
 530 # required arguments: content, location
 531 sub saveFile {
 532   my ($rf,$ar) = @_;
 533   my $new;
 534
 535   http_die("not enough arguments in saveFile") unless $ar;
 536
 537   if ($ar eq 'index.html') {
 538     $ar = "$docdir/index.html"
 539   } elsif ($ar eq 'fex.ph') {
 540     $ar = "$FEXLIB/fex.ph"
 541   } elsif ($ar =~ m'^([^/]+/\@ALLOWED_RECIPIENTS)$') {
 542     $ar = $1;
 543   } else {
 544     http_die("unknown file $ar")
 545   }
 546
 547   $new = $ar.'_new';
 548   if ($ar =~ /fex.ph$/) {
 549     open $new,'>',$new or http_die("cannot open ${ar}_new - $!");
 550     print {$new} $rf;
 551     close $new or http_die("cannot write $new - $!");;
 552     my $status = dehtml(`perl -c $FEXLIB/fex.ph_new 2>&1`);
 553     if ($status =~ /syntax OK/ ) {
 554       rename $ar,"$ar~";
 555       rename $new,$ar;
 556       http_die("cannot write $ar~ - $!") if $?;
 557     } else {
 558       rename "$ar~",$ar;
 559       pq(qq(
 560         'No valid syntax in configuration file:'
 561         '<p><pre>$status</pre><p>'
 562         '<a href="javascript:history.back()">back</a>'
 563       ));
 564       &end_html;
 565     }
 566   } else {
 567     system qw'cp -a',$ar,"$ar~";
 568   }
 569   open $ar,'>',$ar or http_die("cannot write $ar - $!");
 570   print {$ar} $rf;
 571   close $ar or http_die("cannot write $ar - $!");;
 572   print "<code>$ar</code> has been saved\n";
 573   &end_html;
 574 }
 575
 576 # function for deleting existing user
 577 # required arguments: username
 578 sub deleteUser {
 579   my $user = shift;
 580
 581   http_die("not enough arguments in deleteUser") unless $user;
 582
 583   $user = normalize_user($user);
 584
 585   $idf = "$user/\@";
 586   http_die("no such user $user") unless -f $idf;
 587   unlink $idf or http_die("cannot remove $idf - $!");
 588   unlink "$user/\@ALLOWED_RECIPIENTS";
 589   unlink "$user/\@SUBUSER";
 590   rmrf("$user/\@GROUP");
 591   print "$user deleted\n";
 592   &end_html;
 593 }
 594
 595 # function for saving quota information for one single user
 596 # required arguments: username, recipient-quota, sender-quota
 597 sub alterQuota {
 598   my ($user,$rq,$sq) = @_;
 599   my ($rquota,$squota);
 600   my $qf;
 601
 602   $user = normalize_user($user);
 603   http_die("$user is not a F*EX user") unless -d $user;
 604
 605   $rquota = $squota = '';
 606   $qf = "$user/\@QUOTA";
 607   if (open $qf,$qf) {
 608     while (<$qf>) {
 609       s/#.*//;
 610       $rquota = $1 if /recipient.*?(\d+)/i;
 611       $squota = $1 if /sender.*?(\d+)/i;
 612     }
 613     close $qf;
 614   }
 615
 616   $rquota = $1 if $rq and $rq =~ /(\d+)/;
 617   $squota = $1 if $sq and $sq =~ /(\d+)/;
 618   open $qf,'>',$qf or http_die("cannot write $qf - $!");
 619   print {$qf} "recipient:$rquota\n" if $rquota;
 620   print {$qf} "sender:$squota\n"    if $squota;
 621   close $qf or http_die("cannot write $qf - $!");
 622
 623   $rquota = $recipient_quota unless $rquota;
 624   $squota = $sender_quota    unless $squota;
 625   print h3("New quotas for $user");
 626   print "recipient quota: $rquota MB<br>\n";
 627   print "sender quota: $squota MB<br>\n";
 628   &end_html;
 629 }
 630
 631 # function for listing f*exed files
 632 # required arguments: -
 633 sub listFiles {
 634   print h3("List current files");
 635   my ($file,$dkey);
 636   print "<pre>\n";
 637   foreach $recipient (glob "*@*") {
 638     next if -l $recipient;
 639     foreach $file (glob "$recipient/*/*") {
 640       if (-s "$file/data" and  $dkey = readlink("$file/dkey") and -l ".dkeys/$dkey") {
 641         ($to,$from,$file) = split "/",$file;
 642         $file = html_quote($file);
 643         print "$from &rarr; $to : $durl/$dkey/$file\n";
 644       }
 645     }
 646   }
 647   print "</pre>\n";
 648   &end_html;
 649 }
 650
 651 # function for watching the fex-logfile
 652 # required arguments: -
 653 sub watchLog {
 654   if (-f "$logdir/fexsrv.log") {
 655     print h2("polling fexsrv.log"),"\n";
 656     open my $log,"$FEXHOME/bin/logwatch|"
 657       or http_die("cannot run $FEXHOME/bin/logwatch - $!");
 658     dumpfile($log);
 659   } else {
 660     print h2("no fexsrv.log");
 661   }
 662   &end_html;
 663 }
 664
 665 # function for showing logfiles
 666 # required arguments: logfile-name
 667 sub getlog {
 668   my $log = shift or http_die("not enough arguments in getLog");
 669
 670   print h2("show $log");
 671   if (open $log,"$logdir/$log") {
 672     dumpfile($log);
 673     close $log;
 674   } else {
 675     http_die("cannot open $logdir/$log - $!");
 676   }
 677   &end_html;
 678 }
 679
 680 # function for creating a new backup file
 681 # required arguments: -
 682 sub backup {
 683   my @d = localtime time;
 684   my $date = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
 685   my $backup = "backup/config-$date.tar";
 686   my $http_client = $ENV{HTTP_USER_AGENT} || '';
 687   my $size;
 688
 689   my $home = $FEXHOME;
 690   $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
 691
 692   chdir $home or http_die("$home - $!");
 693
 694   unless (-d "backup") {
 695     mkdir "backup",0700 or http_die("cannot mkdir backup - $!");
 696   }
 697
 698   system "tar -cf $backup @backup_files 2>/dev/null";
 699
 700   $size = -s $backup or http_die("backup file empty");
 701
 702   open $backup,'<',$backup or http_die("cannot open $backup - $!");
 703
 704   nvt_print(
 705     'HTTP/1.1 200 OK',
 706     "Content-Length: $size",
 707     "Content-Type: application/octet-stream; filename=fex-backup-$date.tar",
 708     "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
 709     "",
 710   );
 711
 712   while (read($backup,my $b,$bs)) {
 713     print $b or last;
 714   }
 715
 716   exit;
 717 }
 718
 719 # function for restoring an old configuration file
 720 # required arguments: uploaded archive
 721 sub restore {
 722   my $archive_file = shift or http_die("not enough arguments in restore!");
 723   my $restore = "backup.tar";
 724   my $home = $FEXHOME;
 725
 726   $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
 727
 728   chdir $home or http_die("$home - $!");
 729   mkdir 'backup';
 730
 731   open $restore,'>',$restore or http_die("cannot open $restore - $!");
 732   print {$restore} $archive_file;
 733   close $restore or http_die("cannot write $restore - $!");
 734   if (-s $restore) {
 735     print "file upload successful<br>\n";
 736     print "saving actual config in $home/backup/config.tar<br>\n";
 737     print "<pre>\n";
 738     system "tar -cf backup/config.tar @backup_files";
 739     print "</pre>\n";
 740     print "starting restore:\n<p>\n";
 741     print "<pre>\n";
 742     system "tar -xvf $restore";
 743     unlink $restore;
 744     &end_html;
 745   } else {
 746     http_die("upload error - no file data received");
 747   }
 748 }
 749
 750 # function for editing a text-file
 751 # required arguments: filepath, filename
 752 sub editFile {
 753   my $ar = shift;
 754   my $file;
 755
 756   $file = dehtml(slurp($ar));
 757
 758   $ar =~ s:.*/::;
 759
 760   print h2("edit <code>$ar<code>");
 761
 762   pq(qq(
 763     '<form action="/$fac" enctype="multipart/form-data" method="post">'
 764     '<textarea name="contentBox" rows="26" cols="80">'
 765     '$file'
 766     '</textarea><br>'
 767     '<input type="hidden" name="ar" value="$ar">'
 768     '<input type="submit" name="save changes" value="save changes">'
 769     '</form>'
 770   ));
 771   &end_html;
 772 }
 773
 774 # function for showing all users' quotas
 775 # required arguments: -
 776 sub showQuota {
 777
 778   print h2("Show quotas (domain sorted, values in MB)");
 779   print "<table border=\"1\"><tr>";
 780   foreach (@user_items) {
 781     if (/\#\#\#\s(\S+)/) {
 782       print "<tr>";
 783       print "<th>\@$1</th>";
 784       print "<th>sender</th>";
 785       print "<th>sender (used)</th>";
 786       print "<th>recipient</th>";
 787       print "<th>recipient (used)</th>";
 788       print "</tr>\n";
 789 #      $table = $_;
 790     } else {
 791       my $rquota = $recipient_quota;
 792       my $squota = $sender_quota;
 793       my $rquota_used = 0;
 794       my $squota_used = 0;
 795       my $user = $_;
 796       ($squota,$squota_used) = check_sender_quota($user);
 797       ($rquota,$rquota_used) = check_recipient_quota($user);
 798       my $action = "quota&user=$user&rquota=$rquota&squota=$squota";
 799       s/\@.*//;
 800       print "<tr>";
 801       print "<td><a href=\"?action=$action\">$_</a></td>";
 802       print "<td align=\"right\">$squota</td>";
 803       print "<td align=\"right\">$squota_used</td>";
 804       print "<td align=\"right\">$rquota</td>";
 805       print "<td align=\"right\">$rquota_used</td>";
 806       print "</tr>\n";
 807     }
 808   }
 809   print "</table>\n";
 810   &end_html;
 811
 812 }
 813
 814 # function for showing fex-server configuration
 815 # required arguments: -
 816 sub showConfig {
 817   print h3("Show config");
 818   print "<table border=\"0\">\n";
 819   printf "<tr><td>spooldir:</td><td>%s</td>\n",$spooldir;
 820   printf "<tr><td>logdir:</td><td>%s</td>\n",$logdir;
 821   printf "<tr><td>docdir:</td><td>%s</td>\n",$docdir;
 822   printf "<tr><td>durl:</td><td>%s</td>\n",$durl;
 823   printf "<tr><td>mdomain:</td><td>%s</td>\n",$mdomain||'';
 824   printf "<tr><td>autodelete:</td><td>%s</td>\n",$autodelete;
 825   printf "<tr><td>keep:</td><td>%s</td>\n",$keep_default;
 826   printf "<tr><td>keep_max:</td><td>%s</td>\n",$keep_max;
 827   printf "<tr><td>recipient_quota:</td><td>%s</td>\n",$recipient_quota;
 828   printf "<tr><td>sender_quota:</td><td>%s</td>\n",$sender_quota;
 829   printf "<tr><td>admin:</td><td>%s</td>\n",$admin;
 830   print "</table>\n";
 831   &end_html;
 832 }
 833
 834 # require authentification
 835 sub require_akey {
 836   my $id;
 837   my $rid;
 838
 839   if ($action eq 'logout') {
 840     if (($ENV{HTTP_COOKIE}||'') =~ /akey=(\w+)/) {
 841       unlink "$akeydir/$1";
 842     }
 843     nvt_print(
 844       "HTTP/1.1 301 Moved Permanently",
 845       "Location: /$fac",
 846       'Content-Length: 0',
 847       "Set-Cookie: akey=; Max-Age=0; Discard",
 848       ''
 849     );
 850     &reexec;
 851   }
 852
 853   $rid = slurp("$admin/@") or html_error($error,"no F*EX account for $admin");
 854   chomp $rid;
 855
 856   $id = $PARAM{"id"};
 857
 858   if ($id) {
 859     # correct auth-ID?
 860     if ($id eq $rid) {
 861       $akey = md5_hex("$admin:$rid");
 862       return;
 863     }
 864   } elsif ($akey) {
 865     # correct akey?
 866     return if $akey eq md5_hex("$admin:$rid");
 867   }
 868
 869   http_header('200 OK');
 870   print html_header("F*EX Admin Control for $hostname");
 871
 872   if ($akey) {
 873     pq(qq(
 874       '<font color="red"><h3>'
 875       '  wrong akey for <code>$admin</code>'
 876       '</h3></font>'
 877     ));
 878   }
 879
 880   if ($id and $id ne $rid) {
 881     pq(qq(
 882       '<font color="red"><h3>'
 883       '  wrong auth-ID for <code>$admin</code>'
 884       '</h3></font>'
 885     ));
 886   }
 887
 888   pq(qq(
 889     '<form action="/$fac" method="post" enctype="multipart/form-data">'
 890     '  auth-ID for <code>$admin</code>:'
 891     '  <input type="password" name="id" size="16" autocomplete="off">'
 892     '</form>'
 893   ));
 894   &end_html;
 895 }
 896
 897
 898 # function for checking simple HTTP authentication
 899 # (not used any more, replaced with require_akey)
 900 sub require_auth {
 901   if ($ENV{HTTP_AUTHORIZATION} and $ENV{HTTP_AUTHORIZATION} =~ /Basic\s+(.+)/)
 902   { @http_auth = split(':',decode_b64($1)) }
 903   if (
 904     @http_auth != 2
 905     or $http_auth[0] !~ /^(fexmaster|admin|\Q$admin\E)$/
 906     or $http_auth[1] ne $admin_pw
 907   ) {
 908     http_header(
 909       '401 Authorization Required',
 910       "WWW-Authenticate: Basic realm=$admin F*EX admin authentification",
 911       'Content-Length: 0',
 912     );
 913     # control back to fexsrv for further HTTP handling
 914     &reexec;
 915   }
 916 }
 917
 918
 919 # function for sending notification mails to an user
 920 # required arguments: username, auth-id, message-type
 921 sub notifyUser {
 922   my ($user,$id,$type) = @_;
 923   my $url = $durl;
 924   my $message = 'A F*EX account has been created for you. Use';
 925
 926   http_die("not enough arguments in createUser") unless $id;
 927   if ($type and $type eq "change-auth") {
 928     $message = 'New auth-ID for your F*EX account has been set. Use'
 929   }
 930
 931   $user = normalize_user($user);
 932   open my $mail,'|-',$sendmail,'-f',$admin,$user,$bcc
 933     or http_die("cannot start sendmail - $!");
 934   $url =~ s:/fop::;
 935   pq($mail,qq(
 936     'From: $admin'
 937     'To: $user'
 938     'Subject: your F*EX account on $hostname'
 939     'X-Mailer: F*EX'
 940     ''
 941     '$message'
 942     ''
 943     '$url/fup?from=$user'
 944     'auth-ID: $id'
 945     ''
 946     'See $url/index.html for more information about F*EX.'
 947     ''
 948     'Questions? ==> F*EX admin: $admin'
 949   ));
 950   close $mail
 951     or http_die("cannot send notification e-mail (sendmail error $!)");
 952 }
 953
 954
 955 # sort key is the (inverse) domain
 956 # required arguments: list of usernames (e-mail addresses)
 957 sub domainsort {
 958 #    http_die("not enough arguments in domainsort") unless (my @d = @_);
 959   my @d = @_;
 960   local $_;
 961
 962   foreach (@d) {
 963     s/\s//g;
 964     s/\./,/ while /\..*@/;
 965     s/@/@./;
 966     $_ = join('.',reverse(split /\./));
 967   }
 968
 969   @d = sort { lc $a cmp lc $b } @d;
 970
 971   foreach (@d) {
 972     $_ = join('.',reverse(split /\./));
 973     s/,/./g;
 974     s/@\./@/;
 975   }
 976
 977   return @d;
 978 }
 979
 980 # function for creating a sorted list of all users
 981 # required arguments: -
 982 sub userList {
 983   my (@u,@list);
 984   my $domain = '';
 985   my $u;
 986
 987   foreach $u (glob('*@*')) {
 988     next if -l $u;
 989     push @u,$u if -f "$u/@";
 990   }
 991
 992   foreach (domainsort(@u)) {
 993     if (/@(.+)/) {
 994       if ($1 ne $domain) {
 995         push @list,"### $1 ###";
 996       }
 997       push @list,$_;
 998       $domain = $1;
 999     }
1000   }
1001
1002   return @list;
1003 }
1004
1005
1006 sub dumpfile {
1007   my $file = shift;
1008
1009   print "<pre>\n";
1010   while (<$file>) { print dehtml($_) }
1011   print "\n</pre>\n";
1012 }
1013
1014
1015 sub h2 {
1016   local $_ = shift;
1017   chomp;
1018   return "<h2>$_</h2>\n";
1019 }
1020
1021
1022 sub h3 {
1023   local $_ = shift;
1024   chomp;
1025   return "<h3>$_</h3>\n";
1026 }
1027
1028
1029 sub end_html {
1030   print "</body></html>\n";
1031   exit;
1032 }
1033
1034
1035 sub dehtml {
1036   local $_ = shift;
1037   s/&/&amp;/g;
1038   s/</&lt;/g;
1039   return $_;
1040 }