#!/usr/bin/perl -Tw

use 5.005;
use strict;

# $Id: ht-account-manager,v 1.5 2006/02/20 12:55:24 fany Exp $

use CGI ();
use CGI::Carp qw(fatalsToBrowser);
use Errno ();
use Fcntl qw(O_CREAT O_EXCL O_WRONLY LOCK_SH LOCK_EX);
use File::Spec ();
use HTML::Entities qw(encode_entities);
use Getopt::Long qw(GetOptions);
use Symbol qw(gensym);

sub http_s($) {
    'http'
      . ( exists $ENV{HTTPS} && $ENV{HTTPS} eq 'on' ? 's' : '' ) . '://'
      . shift;
}

use constant NAME_RE   => '^[^\0- \177:]+$';    # vgl. RFC 2617, Section 2.2
use constant NORISLOGO => (
    alt    => 'noris network',
    height => '29',
    src    => http_s 'www.noris.net/cms/images/noris_logo.gif',
    width  => '192'
);
use constant SALT => ( '.', '/', 0 .. 9, 'A' .. 'Z', 'a' .. 'z' );
use constant PASSWORD_CHARS => 'abcdefghijkmnopqrstuvwxyz23456789';
use constant PASSWORD_MIN_L => 5;
use constant PASSWORD_MAX_L => 8;

alarm 42;    # nur zur Vermeidung etwaiger Endlosschleifen

use constant MESSAGE => {
    ACTIVATE_CHECKBOX => {
        de =>
'Schalten Sie das Kontrollkstchen in der Zeile mit dem gewnschten Benutzer(innen)namen und der Spalte der jeweiligen Benutzer(innen)gruppe an.',
        en =>
'Just activate the checkbox at the point of intersection between the row belonging to the user name in question and the column of the desired user group.'
    },
    AND                       => { de => 'und', en => 'and' },
    ASSIGNING_USERS_TO_GROUPS => {
        de =>
'Hinzufgen eines Benutzer(innen)-Zugangs zu einer Benutzer(innen)gruppe',
        en => 'Assigning users to user groups'
    },
    ASSIGNMENT_CHANGES_SAVED => {
        de =>
'Etwaige nderungen bei der Benutzer(innen)/Gruppen-Zuordnung wurden bercksichtigt.',
        en =>
'Where applicable, changes regarding user to group assignment have been saved.'
    },
    CANNOT_CREATE_TMPFILE => {
        de => 'Kann die temporre Datei "FILENAME" nicht anlegen: ERRSTR',
        en => 'Cannot create temporary file "FILENAME": ERRSTR'
    },
    CANNOT_LOCK => {
        de => 'Kann "FILENAME" nicht sperren: ERRSTR',
        en => 'Cannot lock "FILENAME": ERRSTR'
    },
    CANNOT_LOCK_TMPFILE => {
        de => 'Kann die temporre Datei "FILENAME" nicht sperren: ERRSTR',
        en => 'Cannot lock temporary file "FILENAME": ERRSTR'
    },
    CANNOT_OPEN => {
        de => 'Kann "FILENAME" nicht ffnen: ERRSTR',
        en => 'Cannot open "FILENAME": ERRSTR'
    },
    CHANGE_GROUP => {
        de => 'ndern Sie den Namen der Gruppe im Tabellenkopf.',
        en =>
          'Just edit the name of the user group within the header of the table.'
    },
    CHANGE_PASSWORD =>
      { de => 'ndern eines Kennwortes', en => 'Changing passwords' },
    CHANGE_SAVED => {
        de => 'Folgende nderung wurde vorgenommen',
        en => 'The following change has been saved'
    },
    CHANGE_USERNAME => {
        de =>
'ndern Sie den betreffenden Benutzer(innen)namen. Das bisherige Kennwort bleibt dabei erhalten.',
        en =>
          'Just edit the user\'s name. The current password will be preserved.'
    },
    CHANGES_SAVED => {
        de => 'Folgende nderungen wurden vorgenommen',
        en => 'The following changes have been saved'
    },
    CREATING_GROUPS => {
        de => 'Neuanlegen einer Benutzer(innen)gruppe',
        en => 'Creation of new user groups'
    },
    CREATING_USERS => {
        de => 'Neuanlegen eines Benutzer(innen)-Zugangs',
        en => 'Creating user accounts'
    },
    DEACTIVATE_CHECKBOX => {
        de =>
'Schalten Sie das Kontrollkstchen in der Zeile mit dem gewnschten Benutzer(innen)namen und der Spalte der jeweiligen Benutzer(innen)gruppe aus.',
        en =>
'Just switch off the checkbox at the point of intersection between the row belonging to the user name in question and the column of the desired user group.'
    },
    DELETE_GROUP => {
        de =>
          'Lschen Sie den Gruppennamen aus dem Eingabefeld im Tabellenkopf.',
        en =>
'Just delete the group\'s name from the input field within the header of the table.'
    },
    DELETING_GROUPS => {
        de => 'Lschen einer Benutzer(innen)gruppe',
        en => 'Deletion of user groups'
    },
    DELETING_USERS => {
        de => 'Lschen eines Benutzer(innen)-Zugangs',
        en => 'Deletion of user accounts'
    },
    ENTER_GROUP => {
        de =>
'Geben Sie den gewnschten neuen Gruppennamen in das leere Feld in der rechten Spalte des Tabellenkopfes ein.',
        en =>
'Please enter the desired group name into the empty field at the right column within the header of the table.'
    },
    ENTER_NEW_PASSWORD => {
        de =>
'Tragen Sie das gewnschte neue Kennwort in das zum jeweiligen Benutzer(innen)-Zugang gehrende Feld der Spalte "COLUMN" ein.',
        en =>
'Please enter the desired new password into the field of the column "COLUMN" of the user account in question.'
    },
    ENTER_SAME_GROUP => {
        de =>
'Tragen Sie in mehreren Spalten des Tabellenkopfes identische Gruppennamen ein. Die neue Benutzer(innen)gruppe enthlt dann alle Benutzer(innen), die Mitglied mindestens einer der Benutzer(innen)gruppen waren, aus denen sie entstanden ist.',
        en =>
'Just enter identical grop names in several columns of the header of the. The merged user group will then contain all users that had been member of at least one of the user groups of which it was composed.'
    },
    ENTER_USERNAME => {
        de =>
'Tragen Sie den gewnschten Benutzer(innen)namen in das freie erste Feld der Spalte "COLUMN_USERNAME" und das gewnschte Kennwort in das danebenstehende Feld "COLUMN_PASSWORD" ein.',
        en =>
'Please enter the desired user name into the free input field of the column "COLUMN_USERNAME" and the desired password in the adjacent field of the column "COLUMN_PASSWORD".'
    },
    ERROR_DELETING_BAKFILE => {
        de => 'Fehler beim Lschen der Sicherungsdatei "FILENAME": ERRSTR',
        en => 'Error deleting backup file "FILENAME": ERRSTR'
    },
    ERROR_LINKING => {
        de =>
'Beim Verlinken von "FILENAME" nach "BAKFILENAME" ist ein Fehler aufgetreten: ERRSTR',
        en => 'Error linking "FILENAME" to "BAKFILENAME": ERRSTR'
    },
    ERROR_RENAMING => {
        de =>
'Beim Umbenennen der temporren Datei "TMPFILENAME" in "FILENAME" ist ein Fehler aufgetreten: ERRSTR',
        en =>
          'Error renaming temporary file "TMPFILENAME" to "FILENAME": ERRSTR'
    },
    ERROR_SAVING_FILE => {
        de =>
          'Beim Schreiben von "FILENAME" ist ein Fehler aufgetreten: ERRSTR',
        en => 'Error writing file "FILENAME": ERRSTR'
    },
    FOUND_INCONSISTENCIES => {
        de =>
          'Bei der berprfung Ihrer Eingaben wurden Inkonsistenzen entdeckt',
        en => 'Inconsistencies have been found when verifying your input'
    },
    FOUND_INCONSISTENCY => {
        de =>
          'Bei der berprfung Ihrer Eingaben wurde eine Inkonsistenz entdeckt',
        en => 'An inconsistency has been found when verifying your input'
    },
    GROUP_CONTAINS_ILLEGAL_CHARS => {
        de =>
'Der Benutzer(innen)gruppenname "NEW_GROUP" enthlt nicht erlaubte Leer- oder Kontrollzeichen (dazu zhlt hier auch der Doppelpunkt); wir behalten daher den bisherigen Namen "GROUP" bei.',
        en =>
'The user group name "NEW_GROUP" contains illegal whitespace and/or control characters (e.g. colons). I\'ll therefore keep the current name "GROUP".'
    },
    GROUP_CREATED => {
        de => 'Die Benutzer(innen)gruppe "GROUP" wurde angelegt.',
        en => 'User group "GROUP" has been created.'
    },
    GROUP_DELETED => {
        de => 'Die bisherige Benutzer(innen)gruppe "GROUP" wurde gelscht.',
        en => 'User group "GROUP" has been deleted.'
    },
    GROUP_MERGED => {
        de =>
'Die Benutzer(innen)gruppe "GROUP" wurde in die Benutzer(innen)gruppe "MERGED_INTO" eingegliedert.',
        de => 'User group "GROUP" has been merged to user group "MERGED_INTO".'
    },
    GROUP_RENAMED => {
        de => 'Die Benutzer(innen)gruppe "FROM" wurde in "TO" umbenannt.',
        en => 'User group "FROM" has been renamed to "TO".'
    },
    GROUP_LEFT => {
        de =>
'"FILENAME" enthlt die in der letzten Maske nicht bercksichtigte Benutzer(innen)gruppe GROUP',
        en =>
'"FILENAME" contains user group "GROUP", which had not been included in the last input mask'
    },
    GROUPS_LEFT => {
        de =>
'"FILENAME" enthlt die in der letzten Maske nicht bercksichtigten Benutzer(innen)gruppe GROUPS',
        en =>
'"FILENAME" contains user groups GROUP, which had not been included in the last input mask'
    },
    INSTRUCTIONS   => { de => 'Kurzanleitung', en => 'Instructions' },
    MERGING_GROUPS => {
        de => 'Zusammenlegen von Benutzer(innen)gruppen.',
        en => 'Merging of user groups'
    },
    MISSING_CGI_PARAM => {
        de =>
'Ich vermisse die CGI-Variable "PARAM". Mglicherweise wurden die Daten unvllstndig bertragen.',
        en =>
'Missing CGI variable "PARAM". Maybe data has been transmitted incompletely.'
    },
    NEW_PASSWORD => { de => '(neues) Kennwort', en => '(new) password' },
    NO_CHANGES   => {
        de => 'Es wurden keine nderungen vorgenommen.',
        en => 'No changes have been saved.'
    },
    NO_CHANGES_SAVED => {
        de =>
'wahrscheinlich wurde die Datei zwischenzeitlich anderweitig verndert. Aus Sicherheitsgrnden werden daher keine nderungen vorgenommen. Bitte rufen Sie diese Seite neu auf, um den aktuellen Stand angezeigt zu bekommen.',
        en =>
'maybe the file has been changed by another user. Therefore, as a precaution no changes have been saved. Please reload this page to continue to work with the current version.'
    },
    PASSWORD_CHANGED => {
        de =>
'Das Kennwort des Zugangs "USER" wurde auf den von Ihnen angegebenen Wert gesetzt.',
        en =>
'The password for user "USER" has been set to the string you had entered.'
    },
    PASSWORD_GENERATION => {
        de =>
'Sofern Sie kein Kennwort angeben, generiert das System beim Speichern der nderungen automatisch ein zuflliges Kennwort und teilt Ihnen dieses beim Anzeigen der nderungen mit.',
        en =>
'Unless you specify one, the application will automatically generate a random password when saving changes and will display the password generated on the next page.'
    },
    REMOVE_USERNAME => {
        de => 'Lschen Sie den betreffenden Namen aus der Spalte "COLUMN".',
        en => 'Please remove the user\'s name from the column "COLUMN".'
    },
    REMOVING_USERS_FROM_GROUPS => {
        de =>
'Entfernen eines Benutzer(innen)-Zugangs aus einer Benutzer(innen)gruppe',
        en => 'Removing users from user groups'
    },
    RENAMING_GROUPS => {
        de => 'Umbenennen einer Benutzer(innen)gruppe',
        en => 'Renaming of user groups'
    },
    RENAMING_USERS => {
        de => 'Umbenennen eines Benutzer(innen)-Zugangs',
        en => 'Renaming of user accounts'
    },
    SEVERAL_CHANGES_POSSIBLE => {
        de =>
'Selbstverstndlich knnen Sie auch mehrere nderungen auf einmal vornehmen.',
        en => 'Of course, you may perform several changes at once.'
    },
    SUBMIT => {
        de =>
'Nach der Fertigstellung aller Eingaben bettigen Sie bitte den Knopf "BUTTON", um die genderten Daten an das Server-System zu bermitteln.',
        en =>
'After finishing your work, please click on "BUTTON" to submit the changes to the server system.'
    },
    SUBMIT_CHANGES => { de => 'nderungen aktivieren', en => 'Submit changes' },
    TITLE          => {
        de => 'Benutzer(innen) und -gruppenverwaltung fr Ihren Web-Space',
        en => 'User and usergroup manager for your web space'
    },
    USER_ACCOUNTS => { de => 'Benutzer(innen)-Zugnge', en => 'User accounts' },
    USER_AND_PASSWORD_CREATED => {
        de =>
          'Der Zugang "USER" wurde mit folgendem Kennwort angelegt: PASSWORD',
        en =>
'User account "USER" has been created with the following password: PASSWORD'
    },
    USER_AND_PASSWORD_REPLACED => {
        de =>
'Der Zugang "OLD_USER" wurde durch den Zugang "NEW_USER" mit dem von Ihnen eingegebenen Kennwort ersetzt.',
        en =>
'User account "OLD_USER" has been replaced with user account "NEW_USER" using the password you had entered.'
    },
    USER_CONTAINS_ILLEGAL_CHARS => {
        de =>
'Der Benutzer(innen)name "USER" enthlt nicht erlaubte Leer- oder Kontrollzeichen (dazu zhlt hier auch der Doppelpunkt).',
        en =>
'Username "USER" contains illegal whitespace or control characters (e.g. colons).'
    },
    USER_CREATED => {
        de =>
'Der Zugang "USER" wurde mit dem von Ihnen angegebenen Kennwort angelegt.',
        en =>
'User account "USER" has been created using the password you had entered.'
    },
    USER_DELETED => {
        de => 'Der/die bisherige Benutzer(in) "USER" wurde gelscht.',
        en => 'User "USER" has been deleted.'
    },
    USER_GROUPS     => { de => 'Benutzer(innen)gruppen', en => 'User groups' },
    USER_NOT_UNIQUE => {
        de =>
'Jeder Benutzer(innen)name kann nur einmal vergeben werden, "USER" wurde jedoch hufiger eingetragen. Bitte lsen Sie den Konflikt!',
        en =>
'Each username may only be used once, "USER", however, has been entered several times. Please resolve this conflict!'
    },
    USER_RENAMED => {
        de =>
'Der Zugang "OLD_USER" wurde in "NEW_USER" umbenannt, das bisherige Kennwort wurde dabei bernommen.',
        en =>
'User account "OLD_USER" has been renamed to "NEW_USER" keeping the present password.'
    },
    USERNAME => { de => 'Benutzer(innen)name', en => 'User name' }
};

sub content($;$) {
    defined $_[0] or return;
    $_[0] =~ s/^\s+|\s+\z//g if $_[1];
    length $_[0];
}

sub gen_password {
    my $password;
    $password .= substr PASSWORD_CHARS, rand length PASSWORD_CHARS, 1
      for 1 .. PASSWORD_MIN_L + rand 1 + PASSWORD_MAX_L - (PASSWORD_MIN_L);
    $password;
}

sub my_crypt($) { crypt shift, join '', (SALT)[ rand SALT, rand SALT ] }

sub open_tmpfile4($) {
    my $filename = shift;
    my $new_filename;
    my $fh = gensym;
    for (
        my $i = $^T ;
        not sysopen $fh, ( $new_filename = "$filename.$i" ),
        O_CREAT | O_EXCL | O_WRONLY ;
        ++$i
      )
    {
        die i18n(
            'CANNOT_CREATE_TMPFILE',
            ERRSTR   => $!,
            FILENAME => $new_filename
          )
          . "\n"
          unless $!{EEXIST};
    }
    flock $fh, LOCK_EX
      or
      die i18n( 'CANNOT_LOCK_TMPFILE', ERRSTR => $!, FILENAME => $new_filename )
      . "\n";
    $new_filename, $fh;
}

sub rotate_backup($$) {
    my ( $file, $tmpfile ) = @_;
    unless ( unlink my $backup = "$file.bak" or $!{ENOENT} ) {
        die i18n( 'ERROR_DELETING_BAKFILE', ERRSTR => $!, FILENAME => $backup )
          . "\n";
    }
    elsif ( not link $file, $backup ) {
        die i18n(
            'ERROR_LINKING',
            BAKFILENAME => $backup,
            ERRSTR      => $!,
            FILENAME    => $file
          )
          . "\n"
          unless $!{ENOENT};
    }
    rename $tmpfile, $file
      or die i18n(
        'ERROR_RENAMING',
        ERRSTR      => $!,
        FILENAME    => $file,
        TMPFILENAME => $tmpfile
      )
      . "\n";
}

### Initialisierung:

GetOptions
  'AuthUserFile=s'  => \our $AuthUserFile,
  'AuthGroupFile=s' => \our $AuthGroupFile,
  'language=s'      => \( our $Language = 'de' ),
  'static-groups'   => \our $StaticGroups,
  'trim-passwords'  => \our $TrimPasswords;

defined and /^(.*)$/ and $_ = $1 for $AuthUserFile, $AuthGroupFile;    # untaint

### I18N fr Arme:

sub i18n {
    my ( $message_id, %ph ) = @_;
    defined( my $message = MESSAGE->{$message_id} )
      or die qq(Unknown message "$message_id".\n);
    defined( $message =
          $message->{ defined $message->{$Language} && $Language } )
      or die qq(Message "$message_id" not defined for language "$Language".\n);
    $message =~
s/(${\ join '|', map quotemeta, sort { length $b <=> length $a } keys %ph })/$ph{$1}/g
      if keys %ph;
    $message;
}

unless ( defined $AuthUserFile ) {    # => Default: /var/www/USER/data/htpasswd
    $ENV{SCRIPT_FILENAME} =~ /^(.*)/;
    my $seen_cgibin;
    my @dir = File::Spec->splitdir($1);
    $AuthUserFile =
      File::Spec->catfile(
        grep( !( $seen_cgibin || $_ eq 'cgi-bin' && ++$seen_cgibin ), @dir ),
        qw(data htpasswd) );
}
elsif ( not File::Spec->file_name_is_absolute($AuthUserFile) ) {
    require File::Basename;
    $ENV{SCRIPTNAME} =~ /^(.*)/;
    $AuthUserFile =
      File::Spec->rel2abs( $AuthUserFile, File::Basename::dirname($1) );
}

my $cgi  = new CGI;
my $mode = $cgi->param;
my ( @users, %group, @changes, @errors );
{

### AuthUserFile einlesen:
    my ( %user, $user_comments, $fh_htpasswd );
    if ( open $fh_htpasswd = gensym, "<$AuthUserFile" ) {
        flock $fh_htpasswd, LOCK_SH
          or die i18n( 'CANNOT_LOCK', ERRSTR => $!, FILENAME => $AuthUserFile )
          . "\n";
        while ( defined( my $line = <$fh_htpasswd> ) ) {
            chomp $line;
            if ( ( my $parts = ( my ( $user, $passwd ) = split /:/, $line ) ) ==
                2 )
            {
                $user{$user} = $passwd;
            }
            else {
                $user_comments .= "$line\n";
            }
        }
        @users = sort keys %user;
    }
    elsif ( !$!{ENOENT} ) {
        die i18n( 'CANNOT_OPEN', ERRSTR => $!, FILENAME => $AuthUserFile )
          . "\n";
    }

### AuthGroupFile einlesen:
    my ( $group_comments, $fh_htgroups );
    if ( defined $AuthGroupFile ) {
        if ( open $fh_htgroups = gensym, "<$AuthGroupFile" ) {
            flock $fh_htgroups, LOCK_SH
              or die i18n(
                'CANNOT_LOCK',
                ERRSTR   => $!,
                FILENAME => $AuthGroupFile
              )
              . "\n";
            while ( defined( my $line = <$fh_htgroups> ) ) {
                if ( $line =~ /^([^:]+):\s*(.*)$/ ) {
                    @{ $group{$1} }{ split ' ', $2 } = ();
                }
                else { $group_comments .= $line }
            }
        }
        elsif ( !$!{ENOENT} ) {
            die i18n( 'CANNOT_OPEN', ERRSTR => $!, FILENAME => $AuthGroupFile )
              . "\n";
        }
    }

### nderungen vornehmen:
    if ($mode) {
        my ( %new_user, %in );
        @users = sort $cgi->param('users');

### nderungen an Gruppen:
        if ( defined $AuthGroupFile ) {
            my @groups = sort $cgi->param('groups');
            my %new_name;
            if ($StaticGroups) { %new_name = map +( $_ => $_ ), keys %group }
            else {
                my %new_group;
                for (@groups) {
                    defined( my $name = $cgi->param("group_$_") )
                      or die i18n( 'MISSING_CGI_PARAM', PARAM => "group_$_" )
                      . "\n";
                    unless ( content $name, 1 ) {
                        defined delete $group{$_}
                          and length
                          and push @changes, i18n 'GROUP_DELETED', GROUP => $_;
                    }
                    elsif ( $name !~ NAME_RE ) {
                        $new_group{ $new_name{$_} = $_ } = $group{$_};
                        push @errors, i18n 'GROUP_CONTAINS_ILLEGAL_CHARS',
                          GROUP     => $_,
                          NEW_GROUP => $name;
                    }
                    elsif ( exists $new_group{$name} ) {
                        @{ $new_group{ $new_name{$_} = $name } }{
                            keys %{ delete $group{$_} } } = ();
                        push @changes, i18n 'GROUP_MERGED',
                          GROUP       => $_,
                          MERGED_INTO => $name;
                    }
                    else {
                        $new_group{ $new_name{$_} = $name } = delete $group{$_};
                        push @changes,
                          length()
                          ? i18n( 'GROUP_RENAMED', FROM  => $_, TO => $name )
                          : i18n( 'GROUP_CREATED', GROUP => $name )
                          if $name ne $_;
                    }
                }
                if ( my @groups_left = map qq("$_"), sort keys %group ) {
                    push @errors,
                      i18n(
                        @groups_left == 1
                        ? ( 'GROUP_LEFT', GROUP => qq("@groups_left") )
                        : (
                            'GROUPS_LEFT',
                            GROUPS => join( ', ',
                                @groups_left[ 0 .. $#groups_left - 1 ] )
                              . ' '
                              . i18n('AND')
                              . " $groups_left[-1]"
                        ),
                        FILENAME => $AuthGroupFile
                      )
                      . '; '
                      . i18n('NO_CHANGES_SAVED');
                }
                %group = %new_group;
            }
            while ( my ( $name, $group ) = each %group ) {
                delete @{$group}{@users};
            }
            for (@groups) {
                if ( my @members = $cgi->param("in_$_") ) {
                    @{ $in{ $new_name{$_} } }{@members} = ();
                }
            }
        }

### nderungen an Benutzer(innen):
        for (@users) {
            defined( my $name = $cgi->param("user_$_") )
              or die i18n( 'MISSING_CGI_PARAM', PARAM => "user_$_" );
            unless ( content $name, 1 ) {
                push @changes, i18n 'USER_DELETED', USER => $_
                  if length;
                while ( ( undef, my $group ) = each %group ) {
                    delete $group->{$_};
                }
            }
            elsif ( $name !~ NAME_RE ) {
                push @errors, i18n 'USER_CONTAINS_ILLEGAL_CHARS', USER => $name;
            }
            elsif ( exists $new_user{$name} ) {
                push @errors, i18n 'USER_NOT_UNIQUE', USER => $name;
            }
            else {
                if ( content +( my $new_pw = $cgi->param("pw_$_") ),
                    $TrimPasswords )
                {
                    $new_user{$name} = my_crypt $new_pw;
                    push @changes,
                      $name eq $_ ? i18n( 'PASSWORD_CHANGED', USER => $_ )
                      : length() ? i18n(
                        'USER_AND_PASSWORD_REPLACED',
                        NEW_USER => $name,
                        OLD_USER => $_
                      )
                      : i18n( 'USER_CREATED', USER => $name );
                }
                elsif ( $user{$_} ) {
                    $new_user{$name} = $user{$_};
                    push @changes,
                      i18n( 'USER_RENAMED', NEW_USER => $name, OLD_USER => $_ )
                      if $name ne $_;
                }
                else {
                    $new_user{$name} = my_crypt( $new_pw = gen_password );
                    push @changes,
                      i18n(
                        'USER_AND_PASSWORD_CREATED',
                        PASSWORD => $new_pw,
                        USER     => $name
                      );
                }
                if ( defined $AuthGroupFile ) {
                    for my $g ( sort keys %group ) {
                        $group{$g}{$name} = undef if exists $in{$g}{$_};
                    }
                }
            }
        }
        push @changes, i18n 'ASSIGNMENT_CHANGES_SAVED'
          if defined $AuthGroupFile;

### nderungen speichern:
        if ( @changes && !@errors ) {
            my ( $new_htpasswd, $fh_new_htpasswd ) =
              open_tmpfile4 $AuthUserFile;
            print $fh_new_htpasswd $user_comments
              if defined $user_comments;
            while ( my ( $name, $passwd ) = each %new_user ) {
                print $fh_new_htpasswd "$name:$passwd\n";
            }
            close $fh_new_htpasswd
              or die i18n(
                'ERROR_SAVING_FILE',
                ERRSTR   => $!,
                FILENAME => $new_htpasswd
              )
              . "\n";
            rotate_backup $AuthUserFile, $new_htpasswd;
            if ( defined $AuthGroupFile ) {
                my ( $new_htgroups, $fh_new_htgroups ) =
                  open_tmpfile4 $AuthGroupFile;
                print $fh_new_htgroups $group_comments
                  if defined $group_comments;
                print $fh_new_htgroups "$_: @{[sort keys %{$group{$_}}]}\n"
                  for sort
                  keys %group;
                close $fh_new_htgroups
                  or die i18n(
                    'ERROR_SAVING_FILE',
                    ERRSTR   => $!,
                    FILENAME => $new_htgroups
                  )
                  . "\n";
                rotate_backup $AuthGroupFile, $new_htgroups;
                close $fh_htgroups;
            }
            close $fh_htpasswd;
            @users = sort keys %new_user;
            $cgi->delete_all;
        }
        else { undef @changes }
    }
}

### Tabelle ausgeben:
{
    unshift @users, '';
    my @groups = ( sort( keys %group ), $StaticGroups ? () : '' )
      if defined $AuthGroupFile;
    { local $^W; print $cgi->header }
    print $cgi->start_html( -title => i18n('TITLE'), -bgcolor => 'white' ),
      $cgi->a(
        { href => http_s 'www.noris.net/', target => "_blank" },
        $cgi->img(
            {
                align  => 'right',
                border => '0',
                NORISLOGO
            }
        )
      ),
      @errors
      ? $cgi->table(
        { bgcolor => '#ffcccc', cellpadding => 8, cellspacing => 0 },
        $cgi->Tr(
            $cgi->td(
                $cgi->p(
                    i18n 'FOUND_INCONSISTENC' . ( @errors == 1 ? 'Y' : 'IES' )
                  )
                  . ':'
                  . $cgi->ul( $cgi->li( [ map encode_entities($_), @errors ] ) )
            )
        )
      )
      : @changes
      ? $cgi->table(
        { bgcolor => '#ccffcc', cellpadding => 8, cellspacing => 0 },
        $cgi->Tr(
            $cgi->td(
                $cgi->p(
                    i18n( 'CHANGE' . ( @changes != 1 && 'S' ) . '_SAVED' ) . ':'
                  )
                  . $cgi->ul(
                    $cgi->li( [ map encode_entities($_), @changes ] ) )
            )
        )
      )
      : $mode
      ? $cgi->table(
        { bgcolor => '#ccccff', cellpadding => 8, cellspacing => 0 },
        $cgi->Tr( $cgi->td( i18n 'NO_CHANGES' ) ) )
      : (), $cgi->start_form( -autocomplete => 'off', -method => 'post' ),
      $cgi->start_table(
        {
            defined $AuthGroupFile ? () : ( align => 'left', hspace => 8 ),
            border      => 1,
            cellspacing => 0
        }
      ),
      $cgi->caption( $cgi->submit( -value => i18n 'SUBMIT_CHANGES' ) ),
      @groups
      ? $cgi->Tr(
        $cgi->th(
            { bgcolor => '#9999ff', colspan => 2 }, i18n 'USER_ACCOUNTS'
          )
          . $cgi->th(
            { bgcolor => '#99ff99', colspan => scalar @groups },
            i18n 'USER_GROUPS'
          )
      )
      : (), $cgi->Tr(
        $cgi->th(
            { bgcolor => '#ccccff' },
            [ map '&nbsp;' . i18n($_) . '&nbsp;', qw(USERNAME NEW_PASSWORD) ]
        ),
        @groups
        ? $cgi->th(
            { bgcolor => '#ccffcc' },
            [
                $StaticGroups
                ? map {
                    ( my $group = encode_entities($_) ) =~ s#-#-<wbr />#g;
                    "&nbsp;$group&nbsp;"
                  } @groups
                : map '&nbsp;'
                  . $cgi->textfield(
                    -name  => "group_$_",
                    -value => $_
                  )
                  . '&nbsp;',
                @groups
            ]
          )
        : ()
      );
    for my $user (@users) {
        print $cgi->Tr(
            $cgi->td(
                { bgcolor => '#eeeeff' },
                [
                    '&nbsp;'
                      . $cgi->textfield(
                        -name  => "user_$user",
                        -value => $user
                      )
                      . '&nbsp;',
                    '&nbsp;'
                      . $cgi->textfield( -name => "pw_$user", -force => 1 )
                      . '&nbsp;'
                ]
            ),
            @groups
            ? $cgi->td(
                { align => 'center', bgcolor => '#eeffee' },
                [
                    map $cgi->checkbox(
                        -autocomplete => 'off',
                        -name         => "in_$_",
                        -value        => $user,
                        -label        => '',
                        -checked      => exists $group{$_}{$user}
                    ),
                    @groups
                ]
              )
            : ()
        );
    }
    print $cgi->end_table,
      $cgi->hidden( -name => 'users', -value => \@users, -force => 1 ),
      defined $AuthGroupFile
      ? $cgi->hidden( -name => 'groups', -value => \@groups, -force => 1 )
      : (), $cgi->end_form, $cgi->hr, $cgi->h2( i18n 'INSTRUCTIONS' ),
      $cgi->dl(
        [
            $cgi->dt( $cgi->b( i18n 'CREATING_USERS' ) )
              . $cgi->dd(
                i18n(
                    'ENTER_USERNAME',
                    COLUMN_PASSWORD => i18n('NEW_PASSWORD'),
                    COLUMN_USERNAME => i18n 'USERNAME'
                  )
                  . $cgi->br
                  . i18n('PASSWORD_GENERATION')
              ),
            $cgi->dt( $cgi->b( i18n 'DELETING_USERS' ) )
              . $cgi->dd(
                i18n( 'REMOVE_USERNAME', COLUMN => i18n 'USERNAME' ) ),
            $cgi->dt( $cgi->b( i18n 'RENAMING_USERS' ) )
              . $cgi->dd( i18n 'CHANGE_USERNAME' ),
            $cgi->dt( $cgi->b( i18n 'CHANGE_PASSWORD' ) )
              . $cgi->dd(
                i18n 'ENTER_NEW_PASSWORD',
                COLUMN => i18n 'NEW_PASSWORD'
              ),
            defined $AuthGroupFile
            ? (
                $cgi->dt( $cgi->b( i18n 'ASSIGNING_USERS_TO_GROUPS' ) )
                  . $cgi->dd( i18n 'ACTIVATE_CHECKBOX' ),
                $cgi->dt( $cgi->b( i18n 'REMOVING_USERS_FROM_GROUPS' ) )
                  . $cgi->dd( i18n 'DEACTIVATE_CHECKBOX' ),
                $StaticGroups
                ? ()
                : (
                    $cgi->dt( $cgi->b( i18n 'CREATING_GROUPS' ) )
                      . $cgi->dd( i18n 'ENTER_GROUP' ),
                    $cgi->dt( $cgi->b( i18n 'DELETING_GROUPS' ) )
                      . $cgi->dd( i18n 'DELETE_GROUP' ),
                    $cgi->dt( $cgi->b( i18n 'RENAMING_GROUPS' ) )
                      . $cgi->dd( i18n 'CHANGE_GROUP' ),
                    $cgi->dt( $cgi->b( i18n 'MERGING_GROUPS' ) )
                      . $cgi->dd( i18n 'ENTER_SAME_GROUP' )
                )
              )
            : ()
        ]
      ),
      $cgi->p(
        [
            i18n('SEVERAL_CHANGES_POSSIBLE'),
            i18n 'SUBMIT',
            BUTTON => i18n('SUBMIT_CHANGES')
        ]
      ),
      $cgi->hr, $cgi->end_html;
}

__END__

=head1 NAME

ht-account-manager - Benutzer und Kennwortverwaltung des Apache

=head1 SYNOPSE

    exec ht-account-manager \
            --AuthUserFile /var/www/.htpasswd \
            --AuthGroupFile /var/www/.groups

=head1 BESCHREIBUNG

Dieses Program editiert die passwd und group Files des Apache. Dabei knnen
neue Benutzer und Gruppen eingefgt und bestehende gelscht werden.

=head1 RCKGABEWERT

HTML-Seite mit dem Formular.

=head1 OPTIONEN

=over 4

=item --AuthUserFile Dateiname

Die Datei in dem die Benutzer und Kennwrter des Passwortgeschtzten Bereichs
liegen.

=item --AuthGroupFile Dateiname

Die Datei in dem die Gruppen des Passwortgeschtzten Bereichs
liegen. (Optional)

=back

=head1 AUTOREN

 Martin H. Sluka <10023626@ticket.noris.net>

