File Coverage

blib/lib/WE/Util/Htpasswd.pm
Criterion Covered Total %
statement 12 59 20.3
branch 0 18 0.0
condition n/a
subroutine 4 9 44.4
pod 3 4 75.0
total 19 90 21.1


line stmt bran cond sub pod time code
1             # -*- perl -*-
2              
3             #
4             # $Id: Htpasswd.pm,v 1.8 2004/04/14 14:42:54 eserte Exp $
5             # Author: Slaven Rezic
6             #
7             # Copyright (C) 2002 Online Office Berlin. All rights reserved.
8             # Copyright (C) 2002 Slaven Rezic.
9             # This is free software; you can redistribute it and/or modify it under the
10             # terms of the GNU General Public License, see the file COPYING.
11              
12             #
13             # Mail: slaven@rezic.de
14             # WWW: http://we-framework.sourceforge.net
15             #
16              
17             package WE::Util::Htpasswd;
18              
19 1     1   918 use strict;
  1         2  
  1         40  
20 1     1   4 use vars qw($VERSION $HTPASSWD_EXE);
  1         2  
  1         64  
21             $VERSION = sprintf("%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/);
22              
23 1     1   5 use File::Spec;
  1         1  
  1         25  
24 1     1   11 use WE::Util::Functions qw(is_in_path _save_pwd);
  1         1  
  1         622  
25              
26             =head1 NAME
27              
28             WE::Util::Htpasswd - create apache .htpasswd files from a user database
29              
30             =head1 SYNOPSIS
31              
32             use WE::Util::Htpasswd;
33             WE::Util::Htpasswd::create("/var/www/.htpasswd", $complex_user_db);
34              
35             =head1 DESCRIPTION
36              
37             Create apache C<.htpasswd> files from a WE_Framework user database.
38              
39             =head2 FUNCTIONS
40              
41             =over 4
42              
43             =item create($dest_file, $user_db, %args);
44              
45             Create the .htpasswd as C<$dest_file> from the (complex) user database
46             object C<$user_db>. Note that the user database should use the "none"
47             C (that is, store plain text passwords).
48              
49             =cut
50              
51             sub create {
52 0     0 1   my($dest_file, $user_db, %args) = @_;
53 0 0         if ($user_db->CryptMode ne 'none') {
54 0           die "CryptMode of the user database should be none";
55             }
56 0           unlink $dest_file;
57 0 0         my $devnull = File::Spec->can("devnull") ? File::Spec->devnull : "/dev/null";
58             #my $devnull = "/tmp/htpasswd-debug.log";
59 0           my $htpasswd = htpasswd_exe();
60 0           my @args = ('-c'); # first time: create htpasswd
61 0           foreach my $uid ($user_db->get_all_users) {
62 0           my $u = $user_db->get_user_object($uid);
63 0           my $p = $u->Password;
64              
65 0           *OLDERR = *OLDERR;
66 0           open(OLDERR, ">&STDERR");
67 0           open(STDERR, ">" . $devnull);
68 0           my @cmd = ($htpasswd, @args, "-b", $dest_file, $uid, $p);
69             _save_pwd {
70             # htpasswd seems to use the current directory as temporary
71             # directory, so help here for a better location:
72 0     0     chdir "/tmp";
73 0           system @cmd;
74 0           };
75 0           close STDERR;
76 0           open(STDERR, ">&OLDERR");
77              
78 0 0         if ($?/256!=0) {
79 0           die "htpasswd for file $dest_file and uid $uid returned " . ($?/256) . "\nCommand line was: @cmd\nPATH was $ENV{PATH}";
80             }
81 0           @args = ();
82             }
83 0           1;
84             }
85              
86             =item add_user($dest_file, $user_object, %args);
87              
88             Add the entry for a user to the C<.htpasswd> file C<$dest_file>. The
89             user object should be a C object as created in
90             C.
91              
92             =cut
93              
94             sub add_user {
95 0     0 1   my($dest_file, $u, %args) = @_;
96 0           my $uid = $u->Username;
97 0           my $p = $u->Password;
98 0           my @args;
99 0 0         if (!-e $dest_file) {
100 0           push @args, "-c";
101             }
102 0           my $htpasswd = htpasswd_exe();
103 0           my @cmd = ($htpasswd, @args, "-b", $dest_file, $uid, $p);
104 0           system @cmd;
105 0 0         if ($?/256!=0) {
106 0           die "htpasswd for file $dest_file and uid $uid returned " . ($?/256) . "\nCommand line was: @cmd";
107             }
108 0           1;
109             }
110              
111             =item invalid_chars
112              
113             Return a string of invalid characters for htpasswd usernames. This is handy
114             for using in C:
115              
116             new WE::DB::ComplexUser(..., ...,
117             -crypt => "none",
118             -invalidchars => WE::Util::Htpasswd::invalid_chars(),
119             -invalidgroupchars => WE::Util::Htgroup::invalid_chars())
120              
121             =cut
122              
123             sub invalid_chars {
124 0     0 1   ":";
125             }
126              
127             sub htpasswd_exe {
128             TRY: {
129 0 0   0 0   if (!defined $HTPASSWD_EXE) {
  0            
130 0           $HTPASSWD_EXE = is_in_path("htpasswd");
131 0 0         last TRY if defined $HTPASSWD_EXE;
132 0           for my $exe (qw(/usr/local/bin/htpasswd
133             /usr/local/apache/bin/htpasswd)) {
134 0 0         if (-x $exe) {
135 0           $HTPASSWD_EXE = $exe;
136 0           last TRY;
137             }
138             }
139             }
140             }
141 0 0         if (!defined $HTPASSWD_EXE) {
142 0           die "Cannot find htpasswd binary in $ENV{PATH}";
143             }
144 0           $HTPASSWD_EXE;
145             }
146              
147             1;
148              
149             __END__