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     $user = normalize_user($PARAM{"editUser"});
 209     if (defined $PARAM{"delete file"}) {
 210       unlink "$user/\@ALLOWED_RECIPIENTS";
 211       print "upload restrictions for $user have been deleted\n";
 212       &end_html;
 213     } else {
 214       editUser($user);
 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 'mv',$ar,"$ar~";
 568   }
 569   $rf =~ s/^\s+$//;
 570   open $ar,'>',$ar or http_die("cannot write $ar - $!");
 571   print {$ar} $rf;
 572   close $ar or http_die("cannot write $ar - $!");;
 573   print "<code>$ar</code> has been saved\n";
 574   &end_html;
 575 }
 576
 577 # function for deleting existing user
 578 # required arguments: username
 579 sub deleteUser {
 580   my $user = shift;
 581
 582   http_die("not enough arguments in deleteUser") unless $user;
 583
 584   $user = normalize_user($user);
 585
 586   $idf = "$user/\@";
 587   http_die("no such user $user") unless -f $idf;
 588   unlink $idf or http_die("cannot remove $idf - $!");
 589   unlink "$user/\@ALLOWED_RECIPIENTS";
 590   unlink "$user/\@SUBUSER";
 591   rmrf("$user/\@GROUP");
 592   print "$user deleted\n";
 593   &end_html;
 594 }
 595
 596 # function for saving quota information for one single user
 597 # required arguments: username, recipient-quota, sender-quota
 598 sub alterQuota {
 599   my ($user,$rq,$sq) = @_;
 600   my ($rquota,$squota);
 601   my $qf;
 602
 603   $user = normalize_user($user);
 604   http_die("$user is not a F*EX user") unless -d $user;
 605
 606   $rquota = $squota = '';
 607   $qf = "$user/\@QUOTA";
 608   if (open $qf,$qf) {
 609     while (<$qf>) {
 610       s/#.*//;
 611       $rquota = $1 if /recipient.*?(\d+)/i;
 612       $squota = $1 if /sender.*?(\d+)/i;
 613     }
 614     close $qf;
 615   }
 616
 617   $rquota = $1 if $rq and $rq =~ /(\d+)/;
 618   $squota = $1 if $sq and $sq =~ /(\d+)/;
 619   open $qf,'>',$qf or http_die("cannot write $qf - $!");
 620   print {$qf} "recipient:$rquota\n" if $rquota;
 621   print {$qf} "sender:$squota\n"    if $squota;
 622   close $qf or http_die("cannot write $qf - $!");
 623
 624   $rquota = $recipient_quota unless $rquota;
 625   $squota = $sender_quota    unless $squota;
 626   print h3("New quotas for $user");
 627   print "recipient quota: $rquota MB<br>\n";
 628   print "sender quota: $squota MB<br>\n";
 629   &end_html;
 630 }
 631
 632 # function for listing f*exed files
 633 # required arguments: -
 634 sub listFiles {
 635   print h3("List current files");
 636   my ($file,$dkey);
 637   print "<pre>\n";
 638   foreach $recipient (glob "*@*") {
 639     next if -l $recipient;
 640     foreach $file (glob "$recipient/*/*") {
 641       if (-s "$file/data" and  $dkey = readlink("$file/dkey") and -l ".dkeys/$dkey") {
 642         ($to,$from,$file) = split "/",$file;
 643         $file = html_quote($file);
 644         print "$from &rarr; $to : $durl/$dkey/$file\n";
 645       }
 646     }
 647   }
 648   print "</pre>\n";
 649   &end_html;
 650 }
 651
 652 # function for watching the fex-logfile
 653 # required arguments: -
 654 sub watchLog {
 655   if (-f "$logdir/fexsrv.log") {
 656     print h2("polling fexsrv.log"),"\n";
 657     open my $log,"$FEXHOME/bin/logwatch|"
 658       or http_die("cannot run $FEXHOME/bin/logwatch - $!");
 659     dumpfile($log);
 660   } else {
 661     print h2("no fexsrv.log");
 662   }
 663   &end_html;
 664 }
 665
 666 # function for showing logfiles
 667 # required arguments: logfile-name
 668 sub getlog {
 669   my $log = shift or http_die("not enough arguments in getLog");
 670
 671   print h2("show $log");
 672   if (open $log,"$logdir/$log") {
 673     dumpfile($log);
 674     close $log;
 675   } else {
 676     http_die("cannot open $logdir/$log - $!");
 677   }
 678   &end_html;
 679 }
 680
 681 # function for creating a new backup file
 682 # required arguments: -
 683 sub backup {
 684   my @d = localtime time;
 685   my $date = sprintf('%d%02d%02d',$d[5]+1900,$d[4]+1,$d[3]);
 686   my $backup = "backup/config-$date.tar";
 687   my $http_client = $ENV{HTTP_USER_AGENT} || '';
 688   my $size;
 689
 690   my $home = $FEXHOME;
 691   $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
 692
 693   chdir $home or http_die("$home - $!");
 694
 695   unless (-d "backup") {
 696     mkdir "backup",0700 or http_die("cannot mkdir backup - $!");
 697   }
 698
 699   system "tar -cf $backup @backup_files 2>/dev/null";
 700
 701   $size = -s $backup or http_die("backup file empty");
 702
 703   open $backup,'<',$backup or http_die("cannot open $backup - $!");
 704
 705   nvt_print(
 706     'HTTP/1.1 200 OK',
 707     "Content-Length: $size",
 708     "Content-Type: application/octet-stream; filename=fex-backup-$date.tar",
 709     "Content-Disposition: attachment; filename=\"fex-backup-$date.tar\"",
 710     "",
 711   );
 712
 713   while (read($backup,my $b,$bs)) {
 714     print $b or last;
 715   }
 716
 717   exit;
 718 }
 719
 720 # function for restoring an old configuration file
 721 # required arguments: uploaded archive
 722 sub restore {
 723   my $archive_file = shift or http_die("not enough arguments in restore!");
 724   my $restore = "backup.tar";
 725   my $home = $FEXHOME;
 726
 727   $home = $1 if $ENV{VHOST} and $ENV{VHOST} =~ /:(.+)/;
 728
 729   chdir $home or http_die("$home - $!");
 730   mkdir 'backup';
 731
 732   open $restore,'>',$restore or http_die("cannot open $restore - $!");
 733   print {$restore} $archive_file;
 734   close $restore or http_die("cannot write $restore - $!");
 735   if (-s $restore) {
 736     print "file upload successful<br>\n";
 737     print "saving actual config in $home/backup/config.tar<br>\n";
 738     print "<pre>\n";
 739     system "tar -cf backup/config.tar @backup_files";
 740     print "</pre>\n";
 741     print "starting restore:\n<p>\n";
 742     print "<pre>\n";
 743     system "tar -xvf $restore";
 744     unlink $restore;
 745     &end_html;
 746   } else {
 747     http_die("upload error - no file data received");
 748   }
 749 }
 750
 751 # function for editing a text-file
 752 # required arguments: filepath, filename
 753 sub editFile {
 754   my $ar = shift;
 755   my $file;
 756
 757   $file = dehtml(slurp($ar));
 758
 759   $ar =~ s:.*/::;
 760
 761   print h2("edit <code>$ar<code>");
 762
 763   pq(qq(
 764     '<form action="/$fac" enctype="multipart/form-data" method="post">'
 765     '<textarea name="contentBox" rows="26" cols="80">'
 766     '$file'
 767     '</textarea><br>'
 768     '<input type="hidden" name="ar" value="$ar">'
 769     '<input type="submit" name="save changes" value="save changes">'
 770     '</form>'
 771   ));
 772   &end_html;
 773 }
 774
 775 # function for showing all users' quotas
 776 # required arguments: -
 777 sub showQuota {
 778
 779   print h2("Show quotas (domain sorted, values in MB)");
 780   print "<table border=\"1\"><tr>";
 781   foreach (@user_items) {
 782     if (/\#\#\#\s(\S+)/) {
 783       print "<tr>";
 784       print "<th>\@$1</th>";
 785       print "<th>sender</th>";
 786       print "<th>sender (used)</th>";
 787       print "<th>recipient</th>";
 788       print "<th>recipient (used)</th>";
 789       print "</tr>\n";
 790 #      $table = $_;
 791     } else {
 792       my $rquota = $recipient_quota;
 793       my $squota = $sender_quota;
 794       my $rquota_used = 0;
 795       my $squota_used = 0;
 796       my $user = $_;
 797       ($squota,$squota_used) = check_sender_quota($user);
 798       ($rquota,$rquota_used) = check_recipient_quota($user);
 799       my $action = "quota&user=$user&rquota=$rquota&squota=$squota";
 800       s/\@.*//;
 801       print "<tr>";
 802       print "<td><a href=\"?action=$action\">$_</a></td>";
 803       print "<td align=\"right\">$squota</td>";
 804       print "<td align=\"right\">$squota_used</td>";
 805       print "<td align=\"right\">$rquota</td>";
 806       print "<td align=\"right\">$rquota_used</td>";
 807       print "</tr>\n";
 808     }
 809   }
 810   print "</table>\n";
 811   &end_html;
 812
 813 }
 814
 815 # function for showing fex-server configuration
 816 # required arguments: -
 817 sub showConfig {
 818   print h3("Show config");
 819   print "<table border=\"0\">\n";
 820   printf "<tr><td>spooldir:</td><td>%s</td>\n",$spooldir;
 821   printf "<tr><td>logdir:</td><td>%s</td>\n",$logdir;
 822   printf "<tr><td>docdir:</td><td>%s</td>\n",$docdir;
 823   printf "<tr><td>durl:</td><td>%s</td>\n",$durl;
 824   printf "<tr><td>mdomain:</td><td>%s</td>\n",$mdomain||'';
 825   printf "<tr><td>autodelete:</td><td>%s</td>\n",$autodelete;
 826   printf "<tr><td>keep:</td><td>%s</td>\n",$keep_default;
 827   printf "<tr><td>keep_max:</td><td>%s</td>\n",$keep_max;
 828   printf "<tr><td>recipient_quota:</td><td>%s</td>\n",$recipient_quota;
 829   printf "<tr><td>sender_quota:</td><td>%s</td>\n",$sender_quota;
 830   printf "<tr><td>admin:</td><td>%s</td>\n",$admin;
 831   print "</table>\n";
 832   &end_html;
 833 }
 834
 835 # require authentification
 836 sub require_akey {
 837   my $id;
 838   my $rid;
 839
 840   if ($action eq 'logout') {
 841     if (($ENV{HTTP_COOKIE}||'') =~ /akey=(\w+)/) {
 842       unlink "$akeydir/$1";
 843     }
 844     nvt_print(
 845       "HTTP/1.1 301 Moved Permanently",
 846       "Location: /$fac",
 847       'Content-Length: 0',
 848       "Set-Cookie: akey=; Max-Age=0; Discard",
 849       ''
 850     );
 851     &reexec;
 852   }
 853
 854   $rid = slurp("$admin/@") or html_error($error,"no F*EX account for $admin");
 855   chomp $rid;
 856
 857   $id = $PARAM{"id"};
 858
 859   if ($id) {
 860     # correct auth-ID?
 861     if ($id eq $rid) {
 862       $akey = md5_hex("$admin:$rid");
 863       return;
 864     }
 865   } elsif ($akey) {
 866     # correct akey?
 867     return if $akey eq md5_hex("$admin:$rid");
 868   }
 869
 870   http_header('200 OK');
 871   print html_header("F*EX Admin Control for $hostname");
 872
 873   if ($akey) {
 874     pq(qq(
 875       '<font color="red"><h3>'
 876       '  wrong akey for <code>$admin</code>'
 877       '</h3></font>'
 878     ));
 879   }
 880
 881   if ($id and $id ne $rid) {
 882     pq(qq(
 883       '<font color="red"><h3>'
 884       '  wrong auth-ID for <code>$admin</code>'
 885       '</h3></font>'
 886     ));
 887   }
 888
 889   pq(qq(
 890     '<form action="/$fac" method="post" enctype="multipart/form-data">'
 891     '  auth-ID for <code>$admin</code>:'
 892     '  <input type="password" name="id" size="16" autocomplete="off">'
 893     '</form>'
 894   ));
 895   &end_html;
 896 }
 897
 898
 899 # function for checking simple HTTP authentication
 900 # (not used any more, replaced with require_akey)
 901 sub require_auth {
 902   if ($ENV{HTTP_AUTHORIZATION} and $ENV{HTTP_AUTHORIZATION} =~ /Basic\s+(.+)/)
 903   { @http_auth = split(':',decode_b64($1)) }
 904   if (
 905     @http_auth != 2
 906     or $http_auth[0] !~ /^(fexmaster|admin|\Q$admin\E)$/
 907     or $http_auth[1] ne $admin_pw
 908   ) {
 909     http_header(
 910       '401 Authorization Required',
 911       "WWW-Authenticate: Basic realm=$admin F*EX admin authentification",
 912       'Content-Length: 0',
 913     );
 914     # control back to fexsrv for further HTTP handling
 915     &reexec;
 916   }
 917 }
 918
 919
 920 # function for sending notification mails to an user
 921 # required arguments: username, auth-id, message-type
 922 sub notifyUser {
 923   my ($user,$id,$type) = @_;
 924   my $url = $durl;
 925   my $message = 'A F*EX account has been created for you. Use';
 926
 927   http_die("not enough arguments in createUser") unless $id;
 928   if ($type and $type eq "change-auth") {
 929     $message = 'New auth-ID for your F*EX account has been set. Use'
 930   }
 931
 932   $user = normalize_user($user);
 933   open my $mail,'|-',$sendmail,'-f',$admin,$user,$bcc
 934     or http_die("cannot start sendmail - $!");
 935   $url =~ s:/fop::;
 936   pq($mail,qq(
 937     'From: $admin'
 938     'To: $user'
 939     'Subject: your F*EX account on $hostname'
 940     'X-Mailer: F*EX'
 941     ''
 942     '$message'
 943     ''
 944     '$url/fup?from=$user'
 945     'auth-ID: $id'
 946     ''
 947     'See $url/index.html for more information about F*EX.'
 948     ''
 949     'Questions? ==> F*EX admin: $admin'
 950   ));
 951   close $mail
 952     or http_die("cannot send notification e-mail (sendmail error $!)");
 953 }
 954
 955
 956 # sort key is the (inverse) domain
 957 # required arguments: list of usernames (e-mail addresses)
 958 sub domainsort {
 959 #    http_die("not enough arguments in domainsort") unless (my @d = @_);
 960   my @d = @_;
 961   local $_;
 962
 963   foreach (@d) {
 964     s/\s//g;
 965     s/\./,/ while /\..*@/;
 966     s/@/@./;
 967     $_ = join('.',reverse(split /\./));
 968   }
 969
 970   @d = sort { lc $a cmp lc $b } @d;
 971
 972   foreach (@d) {
 973     $_ = join('.',reverse(split /\./));
 974     s/,/./g;
 975     s/@\./@/;
 976   }
 977
 978   return @d;
 979 }
 980
 981 # function for creating a sorted list of all users
 982 # required arguments: -
 983 sub userList {
 984   my (@u,@list);
 985   my $domain = '';
 986   my $u;
 987
 988   foreach $u (glob('*@*')) {
 989     next if -l $u;
 990     push @u,$u if -f "$u/@";
 991   }
 992
 993   foreach (domainsort(@u)) {
 994     if (/@(.+)/) {
 995       if ($1 ne $domain) {
 996         push @list,"### $1 ###";
 997       }
 998       push @list,$_;
 999       $domain = $1;
1000     }
1001   }
1002
1003   return @list;
1004 }
1005
1006
1007 sub dumpfile {
1008   my $file = shift;
1009
1010   print "<pre>\n";
1011   while (<$file>) { print dehtml($_) }
1012   print "\n</pre>\n";
1013 }
1014
1015
1016 sub h2 {
1017   local $_ = shift;
1018   chomp;
1019   return "<h2>$_</h2>\n";
1020 }
1021
1022
1023 sub h3 {
1024   local $_ = shift;
1025   chomp;
1026   return "<h3>$_</h3>\n";
1027 }
1028
1029
1030 sub end_html {
1031   print "</body></html>\n";
1032   exit;
1033 }
1034
1035
1036 sub dehtml {
1037   local $_ = shift;
1038   s/&/&amp;/g;
1039   s/</&lt;/g;
1040   return $_;
1041 }