ajt has asked for the wisdom of the Perl Monks concerning the following question:

I've written a small Apache .htaccess password management script for an application on the company intranet. It's fairly basic, and it seems to work okay, and within the confines of a intranet it has been working okay.

I have two basic worries, along with my general phobia of anything users input.

Although I'm allowing users to input their own password, I don't know how to check that it's good. Basically I'd like a password strength checking routine. At the moment I check that the password is 6 characters long, and that there should be at least one character that isn't \w.

My second worry is that when I write the new .htaccess file out, Apache will try and read it, and find that the user isn't there are refuse them. To get round this worry I went for a rename function, so I write out to a tmp file, and then do some renaming - which I think should reduce the risk of a read at the wrong time.

Naturally I've got all sorts of other worries, with the script, I'm not doing much to launder the passwords, and I know that there are other things I could and should be doing, but I'd like input on the key things I should be doing.

For example, reading the code in the cold light of day makes me think that the error messages are to less than ideal.....

Thanks in advance for any input.

#!/perl/bin/perl -T
# Change shebang as appropiate
# IBU Repair Password Management (irs-pass.pl)

#######################################
# Copyright ALARIS Medical Systems 2002
# Version 1.01             17 July 2002
# GNU GPL terms of distribution
#######################################

use warnings;                                    # DISABLE this on IIS
+ in production
use diagnostics;                                # DISABLE in productio
+n
use strict;                                    # 
use lib '.';                                      # Taint mode removes
+ this from @INC

use 5.6.1;                                    # Start with a recent ve
+rsion of Perl
use IRS_Utils;
use CGI;                                    # Does all the smarts
use CGI::Carp qw/fatalsToBrowser/;                # Deal with error me
+ssages properly
use Digest::SHA1;                                # To create the SHA1 
+password hashes
use Fcntl qw(:DEFAULT :flock);                    # Get the File Syste
+m constants
use Net::SMTP;                                    # Send an email if w
+e can

use subs qw(load_password_file password_form user_lock
            make_password_digest save_password_file
            local_sanity_checks verify_password
            open_and_die send_email);        

#    #####
#    START
#    #####


cgi_settings;
my $q = CGI->new;
my %settings = %{get_settings("pass")};

local_sanity_checks $q;
my $user = $q->param("REMOTE_USER");
tad $q, "Runtime error: No username specified." unless $user;

my $old_password   = $q->param("password1");
my $new_password_1 = $q->param("password2");
my $new_password_2 = $q->param("password3");

if ($old_password &&
    $new_password_1 &&
    $new_password_2) {
        tad $q, "The new passwords are not the same.\n<br />Please try
+ again." unless $new_password_1 eq $new_password_2;
        tad $q, "The new password is the same as the old one.\n<br />P
+lease try again." if $new_password_1 eq $old_password;

        verify_password $new_password_1, $q;

        user_lock $q, $settings{write_lock};
        my ($password_list, $file_digest) = load_password_file $q, $us
+er, $settings{htpassfile};
        my $old_digest = make_password_digest($old_password);
        open_and_die $q, "Old password does not match the password in 
+the file." unless $old_digest eq $file_digest;

        my $new_digest = make_password_digest($new_password_1);
        
        my @new_password_list = grep !/^$user/, @$password_list;
        push @new_password_list, ($user . ":{SHA}" . $new_digest . "="
+);
        save_password_file $q, $settings{htpassfile}, \@new_password_l
+ist;
        user_lock $q, $settings{write_lock}, 'open';
        
        print $q->header,
              $q->hr, $q->h1("Password Changed."),
              $q->hr, $q->p("You should close your browser down and re
+start it.");
              $q->hr;

        send_email $q, $user, $new_password_1, $settings{smtp_server} 
+if $settings{smtp_server};
} else {
        password_form
}
clean_exit;



#    -------------
#    Sanity checks
#    -------------
sub local_sanity_checks {
    my $q = shift;
    tad $q, "Runtime error: Can only be run via CGI." unless $q->reque
+st_method;
    tad $q, "The Administrator has locked the password file.\n<br />Pl
+ease try again later." if -e $settings{admin_lock};
    tad $q, "Configuration error: The password file has not been confi
+gured" unless $settings{htpassfile};
    tad $q, "Runtime error: The specified password file is missing." u
+nless -e $settings{htpassfile};
    tad $q, "Runtime error: The password file is empty." if -z _;
    tad $q, "Runtime error: Unable to read password file." unless -r _
+;
    tad $q, "Runtime error: Unable to write to password file." unless 
+-w _;
}


#    ----------------------
#    Load the Password File
#    ----------------------
sub load_password_file {
    my $q    = shift;
    my $user = shift;
    my $file = shift;
    
    open PASS_FILE, "<", $file or tad $q, "Runtime error: Unable to op
+en password file.";
    my @people = <PASS_FILE>;
    close PASS_FILE;

    my @person = grep /^$user/, @people;
    open_and_die $q, "Runtime error: Syntax error in password file." i
+f @person > 1;
    open_and_die $q, "User $user is not in the password file.\n<br />P
+lease contact admin for a username." if @person < 1;

    my ($name, $digest) = split /}/, $person[0];
    chomp $digest;
    chop $digest;
    return \@people, $digest;
}


#    ----------------------------------
#    Save the Password file out to disk
#    ----------------------------------
sub save_password_file {
    my $q        = shift;
    my $filename = shift;
    my $p_list   = shift;

    my $new_filename = $filename . ".new";
    my $old_filename = $filename . ".old";

    open PASS_FILE, ">", $new_filename or tad $q, "Runtime error: Unab
+le to write to password file";
    flock PASS_FILE, LOCK_EX;
    foreach (@$p_list) {
        print PASS_FILE;
    }
    print PASS_FILE "\n";
    flock PASS_FILE, LOCK_UN;
    close PASS_FILE;

    open_and_die $q, "The Administrator has locked the password file.\
+n<br />Please try again later." if -e $settings{admin_lock};
    rename $filename, $old_filename;
    rename $new_filename, $filename;
}

#    -------------------------------------
#    Verify that a password is good enough
#    -------------------------------------
sub verify_password {
    my $password = shift;
    my $q = shift;
    
    tad $q, "Password is not long enough.\n<br/>Please use 6 character
+s or more." if (length $password) < 6;
    tad $q, "Password is not strong enough.\n<br />Please use some cha
+tacters other than just letters and numbers." unless $password =~ /\W
+/;
}


#    ----------------------------------------
#    Make a SHA1 Password Digest for the user
#    ----------------------------------------
sub    make_password_digest{
    my $ctx = Digest::SHA1->new;
    $ctx->add(shift);
    return $ctx->b64digest;
}


#    -------------------------
#    Print out a password form
#    -------------------------
sub password_form {

    print $q->header,
          $q->start_form(-method => 'POST',
                         -name   => 'form',
                         -action => '/repair/ibu-repair-passman.html')
+,
          $q->table({-class  => 'form'},
                           $q->Tr($q->th("Old Password:"),
                           $q->td($q->password_field(-name => 'passwor
+d1', -size => '15', -maxlength => '30'))),
                    $q->Tr($q->th("New Password:"),
                           $q->td($q->password_field(-name => 'passwor
+d2', -size => '15', -maxlength => '30'))),
                    $q->Tr($q->th("New Password:"),
                           $q->td($q->password_field(-name => 'passwor
+d3', -size => '15', -maxlength => '30'))),
                    $q->Tr($q->td({-class => 'submit', -colspan => '2'
+},$q->submit(-name => 'submit', -value => 'Change Password')))),
          $q->hidden(-name => 'cache', -value => 'off'),
          $q->end_form,
}


#    ------------------------
#    Open and close user lock
#    ------------------------
sub    user_lock {
    my $q      = shift;
    my $file   = shift;
    my $open   = shift;

    if ($open) {
        unlink $file if -e $file;
    } else {
        my $escape;
        while (-e $file) {
            tad $q, "The password file has been locked by another user
+.\n<br/>Please try again shortly." if $escape >= 10;
            $escape++;
            sleep (1);
        }
        sysopen (LOCK_FILE, $file, O_WRONLY | O_EXCL |O_CREAT) or tad 
+$q, "The password file has been locked by another user.\n<br/>Please 
+try again shortly.";
        close LOCK_FILE;
    }
}


#    -----------------------
#    Open Lock and Terminate
#    -----------------------
sub open_and_die {
    my $q       = shift;
    my $message = shift;

    user_lock $q, $settings{write_lock}, 'open';
    tad $q, $message;
}


#    -------------------------
#    Send a confirmation email
#    -------------------------
sub send_email {
    my $q      = shift;
    my $user   = shift;
    my $pass   = shift;
    my $server = shift;
    my $address=  lc($user) . "\@alarismed.com";
    
    my $smtp = Net::SMTP->new($server, Timeout => 30);

    if ($smtp &&
        $smtp->mail($address) &&
        $smtp->to($address) &&
        $smtp->data())
        {
        $smtp->datasend("Subject: IBU Service Management Password Chan
+ge Confirmation\n" .
                        "To: $address\n\n" .
                        "User: $user\n" .
                        "New Password: $pass\n\n");
        $smtp->dataend();
        $smtp->quit;
        }
}

[download]

Replies are listed 'Best First'.
Re: Writing to a .htaccess file, while it's in use
by amphiplex (Monk) on Jul 23, 2002 at 09:14 UTC
    Hi !

    The first thing I noticed: You are grepping for /^$user/, shouldn't you grep for /^$user:/ ?
    If you have, for example, a user named "foo" and another one named "foobar", your grep would catch both and generate an error.

    Another point: You should print the same error message for the case that the user is not found in the passwordfile and the passwords don't match. This way an attacker can't easily get a list of valid usernames.

    Update:
    • to check password strength, you could use Crypt::Cracklib
    • You shouldn't be sending passwords per email

    ---- amphiplex
[reply]

Back to Seekers of Perl Wisdom