[Catalyst-commits] r6532 - in trunk/Authen-Htpasswd: . lib/Authen
lib/Authen/Htpasswd t
adamk at dev.catalyst.perl.org
adamk at dev.catalyst.perl.org
Sun Jul 15 22:28:16 GMT 2007
Author: adamk
Date: 2007-07-15 22:28:14 +0100 (Sun, 15 Jul 2007)
New Revision: 6532
Added:
trunk/Authen-Htpasswd/Makefile.PL
trunk/Authen-Htpasswd/README
Modified:
trunk/Authen-Htpasswd/Changes
trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm
trunk/Authen-Htpasswd/lib/Authen/Htpasswd/User.pm
trunk/Authen-Htpasswd/lib/Authen/Htpasswd/Util.pm
trunk/Authen-Htpasswd/t/01use.t
trunk/Authen-Htpasswd/t/02pod.t
trunk/Authen-Htpasswd/t/03podcoverage.t
trunk/Authen-Htpasswd/t/04core.t
trunk/Authen-Htpasswd/t/05edit.t
Log:
Lets try that again
Modified: trunk/Authen-Htpasswd/Changes
===================================================================
--- trunk/Authen-Htpasswd/Changes 2007-07-15 21:19:28 UTC (rev 6531)
+++ trunk/Authen-Htpasswd/Changes 2007-07-15 21:28:14 UTC (rev 6532)
@@ -1,3 +1,7 @@
+0.16 Sun Jul 15 2007
+ - Disable write locking on Win32.
+ (On Win32 you cannot delete a file with an open filehandle)
+
0.15001 Sun Jul 15 00:07:00 PDT 2007
- use File::Spec in tests to avoid build failure on Windows
Copied: trunk/Authen-Htpasswd/Makefile.PL (from rev 6530, trunk/Authen-Htpasswd/Makefile.PL)
===================================================================
--- trunk/Authen-Htpasswd/Makefile.PL (rev 0)
+++ trunk/Authen-Htpasswd/Makefile.PL 2007-07-15 21:28:14 UTC (rev 6532)
@@ -0,0 +1,21 @@
+use strict;
+use ExtUtils::MakeMaker;
+
+require 5.005;
+
+WriteMakefile(
+ 'NAME' => 'Authen::Htpasswd',
+ 'ABSTRACT' => 'Interface to read and modify Apache .htpasswd files',
+ 'AUTHOR' => 'David Kamholz <dkamholz at cpan.org>',
+ 'INSTALLDIRS' => 'site',
+ 'LICENSE' => 'perl',
+ 'VERSION_FROM' => 'lib/Authen/Htpasswd.pm',
+ 'PREREQ_PM' => {
+ 'Class::Accessor::Fast' => 0,
+ 'IO::LockedFile' => 0,
+ 'Digest' => 0,
+ 'Digest::SHA1' => 0,
+ 'Crypt::PasswdMD5' => 0,
+ },
+
+);
Copied: trunk/Authen-Htpasswd/README (from rev 6530, trunk/Authen-Htpasswd/README)
===================================================================
--- trunk/Authen-Htpasswd/README (rev 0)
+++ trunk/Authen-Htpasswd/README 2007-07-15 21:28:14 UTC (rev 6532)
@@ -0,0 +1,99 @@
+NAME
+ Authen::Htpasswd - interface to read and modify Apache .htpasswd files
+
+SYNOPSIS
+ my $pwfile = Authen::Htpasswd->new('user.txt', { encrypt_hash => 'md5' });
+
+ # authenticate a user (checks all hash methods by default)
+ if ($pwfile->check_user_password('bob', 'foo')) { ... }
+
+ # modify the file (writes immediately)
+ $pwfile->update_user('bob', $password, $info);
+ $pwfile->add_user('jim', $password);
+ $pwfile->delete_user('jim');
+
+ # get user objects tied to a file
+ my $user = $pwfile->lookup_user('bob');
+ if ($user->check_password('vroom', [qw/ md5 sha1 /])) { ... } # only use secure hashes
+ $user->password('foo'); # writes to file
+ $user->set(password => 'bar', extra_info => 'editor'); # change more than one thing at once
+
+ # or manage the file yourself
+ my $user = Authen::Htpasswd::User->new('bill', { hashed_password => 'iQ.IuWbUIhlPE' });
+ my $user = Authen::Htpasswd::User->new('bill', 'bar', 'staff', { encrypt_hash => 'crypt' });
+ print PASSWD $user->to_line, "\n";
+
+DESCRIPTION
+ This module provides a convenient, object-oriented interface to
+ Apache-style .htpasswd files. It supports passwords encrypted via MD5,
+ SHA1, and crypt, as well as plain (cleartext) passwords. It requires
+ Crypt::PasswdMD5 for MD5 and Digest::SHA1 for SHA1. Additional fields
+ after username and password, if present, are accessible via the
+ "extra_info" array.
+
+METHODS
+ new
+ my $pwfile = Authen::Htpasswd->new($filename, \%options);
+
+ Creates an object for a given .htpasswd file. Options:
+
+ encrypt_hash
+ How passwords should be encrypted if a user is added or changed.
+ Valid values are "md5", "sha1", "crypt", and "plain". Default is
+ "crypt".
+
+ check_hashes
+ An array of hash methods to try when checking a password. The
+ methods will be tried in the order given. Default is "md5", "sha1",
+ "crypt", "plain".
+
+ lookup_user
+ my $userobj = $pwfile->lookup_user($username);
+
+ Returns an Authen::Htpasswd::User object for the given user in the
+ password file.
+
+ all_users
+ my @users = $pwfile->all_users;
+
+ check_user_password
+ $pwfile->check_user_password($username,$password);
+
+ Returns whether the password is valid. Shortcut for
+ "$pwfile->lookup_user($username)->check_password($password)".
+
+ update_user
+ $pwfile->update_user($userobj);
+ $pwfile->update_user($username, $password[, @extra_info], \%options);
+
+ Modifies the entry for a user saves it to the file. If the user entry
+ does not exist, it is created. The options in the second form are passed
+ to Authen::Htpasswd::User.
+
+ add_user
+ $pwfile->add_user($userobj);
+ $pwfile->add_user($username, $password[, @extra_info], \%options);
+
+ Adds a user entry to the file. If the user entry already exists, an
+ exception is raised. The options in the second form are passed to
+ Authen::Htpasswd::User.
+
+ delete_user
+ $pwfile->delete_user($userobj);
+ $pwfile->delete_user($username);
+
+ Removes a user entry from the file.
+
+AUTHOR
+ David Kamholz "dkamholz at cpan.org"
+
+ Yuval Kogman
+
+SEE ALSO
+ Apache::Htpasswd.
+
+COPYRIGHT & LICENSE
+ Copyright (c) 2005 the aforementioned authors. All rights
+ reserved. This program is free software; you can redistribute
+ it and/or modify it under the same terms as Perl itself.
+
Modified: trunk/Authen-Htpasswd/lib/Authen/Htpasswd/User.pm
===================================================================
--- trunk/Authen-Htpasswd/lib/Authen/Htpasswd/User.pm 2007-07-15 21:19:28 UTC (rev 6531)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd/User.pm 2007-07-15 21:28:14 UTC (rev 6532)
@@ -5,6 +5,11 @@
use Authen::Htpasswd;
use Authen::Htpasswd::Util;
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '0.16';
+}
+
use overload '""' => \&to_line, bool => sub { 1 }, fallback => 1;
__PACKAGE__->mk_accessors(qw/ file encrypt_hash check_hashes /);
Modified: trunk/Authen-Htpasswd/lib/Authen/Htpasswd/Util.pm
===================================================================
--- trunk/Authen-Htpasswd/lib/Authen/Htpasswd/Util.pm 2007-07-15 21:19:28 UTC (rev 6531)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd/Util.pm 2007-07-15 21:28:14 UTC (rev 6532)
@@ -1,11 +1,15 @@
package Authen::Htpasswd::Util;
-require Exporter;
- at ISA = qw/ Exporter /;
- at EXPORT = qw/ htpasswd_encrypt /;
use strict;
use Digest;
use Carp;
+use vars qw{@ISA @EXPORT};
+BEGIN {
+ require Exporter;
+ @ISA = qw/ Exporter /;
+ @EXPORT = qw/ htpasswd_encrypt /;
+}
+
my @CRYPT_CHARS = split(//, './0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz');
=head1 NAME
Modified: trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm
===================================================================
--- trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm 2007-07-15 21:19:28 UTC (rev 6531)
+++ trunk/Authen-Htpasswd/lib/Authen/Htpasswd.pm 2007-07-15 21:28:14 UTC (rev 6532)
@@ -1,12 +1,17 @@
package Authen::Htpasswd;
+use 5.005;
use strict;
use base 'Class::Accessor::Fast';
use Carp;
+use IO::File;
use IO::LockedFile;
use Authen::Htpasswd::User;
-our $VERSION = '0.15001';
-our $SUFFIX = '.new';
+use vars qw{$VERSION $SUFFIX};
+BEGIN {
+ $VERSION = '0.16';
+ $SUFFIX = '.new';
+}
__PACKAGE__->mk_accessors(qw/ file encrypt_hash check_hashes /);
@@ -39,11 +44,15 @@
=head1 DESCRIPTION
-This module provides a convenient, object-oriented interface to Apache-style F<.htpasswd> files.
-It supports passwords encrypted via MD5, SHA1, and crypt, as well as plain (cleartext) passwords.
-It requires L<Crypt::PasswdMD5> for MD5 and L<Digest::SHA1> for SHA1. Additional fields after
-username and password, if present, are accessible via the C<extra_info> array.
+This module provides a convenient, object-oriented interface to Apache-style
+F<.htpasswd> files.
+It supports passwords encrypted via MD5, SHA1, and crypt, as well as plain
+(cleartext) passwords.
+
+Additional fields after username and password, if present, are accessible via
+the C<extra_info> array.
+
=head1 METHODS
=head2 new
@@ -70,7 +79,7 @@
sub new {
my $class = shift;
- my $self = ref $_[-1] eq 'HASH' ? pop @_ : {};
+ my $self = ref $_[-1] eq 'HASH' ? pop @_ : {};
$self->{file} = $_[0] if $_[0];
croak "no file specified" unless $self->{file};
if (!-e $self->{file}) {
@@ -79,8 +88,15 @@
}
$self->{encrypt_hash} ||= 'crypt';
- $self->{check_hashes} ||= [ Authen::Htpasswd::Util::supported_hashes() ];
-
+ $self->{check_hashes} ||= [ Authen::Htpasswd::Util::supported_hashes() ];
+ unless ( defined $self->{write_locking} ) {
+ if ( $^O eq 'MSWin32' or $^O eq 'cygwin' ) {
+ $self->{write_locking} = 0;
+ } else {
+ $self->{write_locking} = 1;
+ }
+ }
+
bless $self, $class;
}
@@ -100,14 +116,16 @@
chomp $line;
my ($username,$hashed_password, at extra_info) = split /:/, $line;
if ($username eq $search_username) {
+ $file->close or die $!;
return Authen::Htpasswd::User->new($username,undef, at extra_info, {
- file => $self,
+ file => $self,
hashed_password => $hashed_password,
- encrypt_hash => $self->encrypt_hash,
- check_hashes => $self->check_hashes
+ encrypt_hash => $self->encrypt_hash,
+ check_hashes => $self->check_hashes
});
}
}
+ $file->close or die $!;
return undef;
}
@@ -132,6 +150,7 @@
check_hashes => $self->check_hashes
}));
}
+ $file->close or die $!;
return @users;
}
@@ -173,13 +192,13 @@
chomp $line;
my (undef,undef, at extra_info) = split /:/, $line;
$user->{extra_info} ||= [ @extra_info ] if scalar @extra_info;
- print $new $user->to_line, "\n";
+ $self->_print( $new, $user->to_line . "\n" );
$seen++;
} else {
- print $new $line;
+ $self->_print( $new, $line );
}
}
- print $new $user->to_line, "\n" unless $seen;
+ $self->_print( $new, $user->to_line . "\n" ) unless $seen;
$self->_finish_rewrite($old,$new);
}
@@ -204,9 +223,9 @@
$self->_abort_rewrite;
croak "user $username already exists in " . $self->file . "!";
}
- print $new $line;
+ $self->_print( $new, $line );
}
- print $new $user->to_line, "\n";
+ $self->_print( $new, $user->to_line . "\n" );
$self->_finish_rewrite($old,$new);
}
@@ -226,11 +245,20 @@
my ($old,$new) = $self->_start_rewrite;
while (defined(my $line = <$old>)) {
next if $line =~ /^\Q$username\:/;
- print $new $line;
+ $self->_print( $new, $line );
}
$self->_finish_rewrite($old,$new);
}
+sub _print {
+ my ($self,$new,$string) = @_;
+ if ( $self->{write_locking} ) {
+ print $new $string;
+ } else {
+ $$new .= $string;
+ }
+}
+
sub _get_user {
my $self = shift;
return $_[0] if $_[0]->isa('Authen::Htpasswd::User');
@@ -242,23 +270,40 @@
sub _start_rewrite {
my $self = shift;
- my $old = IO::LockedFile->new($self->file, 'r+') or die $!;
- my $new = IO::File->new($self->file . $SUFFIX, 'w') or die $!;
- return ($old,$new);
+ if ( $self->{write_locking} ) {
+ my $old = IO::LockedFile->new($self->file, 'r+') or die $!;
+ my $new = IO::File->new($self->file . $SUFFIX, 'w') or die $!;
+ return ($old,$new);
+ } else {
+ my $old = IO::File->new( $self->file, 'r' ) or die $!;
+ my $new = "";
+ return ($old, \$new);
+ }
}
sub _finish_rewrite {
my ($self,$old,$new) = @_;
- $new->close or die $!;
- rename $self->file . $SUFFIX, $self->file or die $!;
- $old->close or die $!;
+ if ( $self->{write_locking} ) {
+ $new->close or die $!;
+ rename $self->file . $SUFFIX, $self->file or die $!;
+ $old->close or die $!;
+ } else {
+ $old->close or die $!;
+ $old = IO::File->new( $self->file, 'w' ) or die $!;
+ print $old $$new;
+ $old->close or die $!;
+ }
}
sub _abort_rewrite {
my ($self,$old,$new) = @_;
- $new->close;
- $old->close;
- unlink $self->file . $SUFFIX;
+ if ( $self->{write_locking} ) {
+ $new->close;
+ $old->close;
+ unlink $self->file . $SUFFIX;
+ } else {
+ $old->close;
+ }
}
=head1 AUTHOR
@@ -273,8 +318,9 @@
=head1 COPYRIGHT & LICENSE
- Copyright (c) 2005 the aforementioned authors. All rights
- reserved. This program is free software; you can redistribute
+ Copyright (c) 2005 - 2007 the aforementioned authors.
+
+ This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.
=cut
Modified: trunk/Authen-Htpasswd/t/01use.t
===================================================================
--- trunk/Authen-Htpasswd/t/01use.t 2007-07-15 21:19:28 UTC (rev 6531)
+++ trunk/Authen-Htpasswd/t/01use.t 2007-07-15 21:28:14 UTC (rev 6532)
@@ -1,8 +1,11 @@
#!perl
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
use Test::More 'no_plan';
-use strict;
-use warnings;
-
-use_ok 'Authen::Htpasswd';
+use_ok('Authen::Htpasswd');
Modified: trunk/Authen-Htpasswd/t/02pod.t
===================================================================
--- trunk/Authen-Htpasswd/t/02pod.t 2007-07-15 21:19:28 UTC (rev 6531)
+++ trunk/Authen-Htpasswd/t/02pod.t 2007-07-15 21:28:14 UTC (rev 6532)
@@ -1,3 +1,11 @@
+#!perl
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
use Test::More;
eval "use Test::Pod 1.14";
Modified: trunk/Authen-Htpasswd/t/03podcoverage.t
===================================================================
--- trunk/Authen-Htpasswd/t/03podcoverage.t 2007-07-15 21:19:28 UTC (rev 6531)
+++ trunk/Authen-Htpasswd/t/03podcoverage.t 2007-07-15 21:28:14 UTC (rev 6532)
@@ -1,3 +1,11 @@
+#!perl
+
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
use Test::More;
eval "use Test::Pod::Coverage 1.04";
Modified: trunk/Authen-Htpasswd/t/04core.t
===================================================================
--- trunk/Authen-Htpasswd/t/04core.t 2007-07-15 21:19:28 UTC (rev 6531)
+++ trunk/Authen-Htpasswd/t/04core.t 2007-07-15 21:28:14 UTC (rev 6532)
@@ -1,9 +1,13 @@
#!/perl
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
use Test::More tests => 13;
-use strict;
-use warnings;
use Authen::Htpasswd;
use File::Spec::Functions;
Modified: trunk/Authen-Htpasswd/t/05edit.t
===================================================================
--- trunk/Authen-Htpasswd/t/05edit.t 2007-07-15 21:19:28 UTC (rev 6531)
+++ trunk/Authen-Htpasswd/t/05edit.t 2007-07-15 21:28:14 UTC (rev 6532)
@@ -1,10 +1,13 @@
#!/perl
+use strict;
+BEGIN {
+ $| = 1;
+ $^W = 1;
+}
+
use Test::More tests => 28;
-use strict;
-use warnings;
-
use Authen::Htpasswd;
use File::Spec::Functions;
More information about the Catalyst-commits
mailing list