line
stmt
bran
cond
sub
pod
time
code
1
# $Date: 2007-02-07 15:54:57 -0600 (Wed, 07 Feb 2007) $
2
# $Revision: 19 $
3
4
package Web::Passwd;
5
1
1
24958
use base 'CGI::Application';
1
3
1
1364
6
7
1
1
15475
use strict;
1
3
1
37
8
1
1
7
use warnings;
1
8
1
36
9
1
1
4035
use CGI::Carp qw/fatalsToBrowser warningsToBrowser/;
1
3141
1
6
10
1
1
2719
use Config::Tiny;
1
1085
1
2101
11
12
# set up application framework, including mode parameter and dispatch table
13
sub setup {
14
0
0
1
my $self = shift;
15
0
$self->start_mode('index');
16
0
$self->mode_param('mode');
17
0
$self->run_modes(
18
'index' => 'display_index',
19
'view' => 'display_htfile',
20
'adduser' => 'user_op',
21
'changepw' => 'user_op',
22
'deluser' => 'user_op',
23
);
24
25
# return just to be tidy
26
0
return;
27
}
28
29
# perform final actions after all other processing
30
sub teardown {
31
# trigger the printing of any warnings to browser as HTML comments
32
0
0
1
warningsToBrowser(1);
33
34
# return just to be tidy
35
0
return;
36
}
37
38
# display index page with no actions to be performed
39
sub display_index {
40
0
0
0
my $self = shift;
41
42
# load configuration as a hash ref
43
0
$self->param('act_config', load_config( $self->param('config') ) );
44
45
# load template file with HTML::Template
46
0
my $tmpl_obj;
47
0
0
if(-e $self->param('act_config')->{'_'}->{'tmpl_path'} . 'index.tmpl' ) {
48
0
$tmpl_obj = $self->load_tmpl( $self->param('act_config')->{'_'}->{'tmpl_path'} . 'index.tmpl' );
49
}
50
else {
51
0
$tmpl_obj = $self->load_tmpl( \$Web::Passwd::INDEX_TEMPLATE );
52
}
53
54
# get list of htpasswd config blocks
55
0
my @htfiles;
56
0
for my $key (keys %{$self->param('act_config')}) {
0
57
0
0
if($key ne '_') {
58
0
push(@htfiles, {'TITLE' => $key});
59
}
60
}
61
62
# pass template parameters
63
$tmpl_obj->param(
64
0
'HTFILES' => \@htfiles,
65
'IS_WARNINGS' => $#CGI::Carp::WARNINGS + 1,
66
'FORM_METHOD' => $self->param('act_config')->{'_'}->{'form_method'},
67
);
68
69
# return template-generated output
70
0
return $tmpl_obj->output;
71
}
72
73
# display page to view/manage a specific htpasswd file
74
sub display_htfile {
75
0
0
0
my $self = shift;
76
77
# get CGI query object
78
0
my $query_obj = $self->query();
79
80
# load configuration as a hash ref
81
0
$self->param('act_config', load_config( $self->param('config') ) );
82
83
# load template file with HTML::Template
84
0
my $tmpl_obj;
85
0
0
if(-e $self->param('act_config')->{'_'}->{'tmpl_path'} . 'view.tmpl' ) {
86
0
$tmpl_obj = $self->load_tmpl( $self->param('act_config')->{'_'}->{'tmpl_path'} . 'view.tmpl' );
87
}
88
else {
89
0
$tmpl_obj = $self->load_tmpl( \$Web::Passwd::VIEW_TEMPLATE );
90
}
91
92
# get user list and format for template processing
93
0
my @users;
94
0
for my $user ( htfile_listusers( $self->param('act_config')->{ $query_obj->param('htfile') }->{'path'} ) ) {
95
0
push(@users, {'USERNAME' => $user});
96
}
97
98
# pass template parameters
99
$tmpl_obj->param(
100
0
'HTFILENAME' => $query_obj->param('htfile'),
101
'USER_LOOP' => \@users,
102
'IS_WARNINGS' => $#CGI::Carp::WARNINGS + 1,
103
'FORM_METHOD' => $self->param('act_config')->{'_'}->{'form_method'},
104
);
105
106
# return template-generated output
107
0
return $tmpl_obj->output;
108
}
109
110
# display the status of an operation
111
sub display_status {
112
0
0
0
my($self, $mode, $htfile, @users) = @_;
113
114
# load template file with HTML::Template
115
0
my $tmpl_obj;
116
0
0
if(-d $self->param('act_config')->{'_'}->{'tmpl_path'}.'status.tmpl' ) {
117
0
$tmpl_obj = $self->load_tmpl( $self->param('act_config')->{'_'}->{'tmpl_path'}.'status.tmpl' );
118
}
119
else {
120
0
$tmpl_obj = $self->load_tmpl( \$Web::Passwd::STATUS_TEMPLATE );
121
}
122
123
# build action status header
124
0
0
my $act_stat = ($mode eq 'adduser') ? "Addition Successful"
0
0
125
: ($mode eq 'changepw') ? "Modification Successful"
126
: ($mode eq 'deluser') ? "Deletion Successful"
127
: "Action Successful";
128
129
# build action message
130
0
0
0
my $act_msg = ($mode eq 'adduser') ? sprintf("User '%s' added.", $users[0])
0
0
0
0
131
: ($mode eq 'changepw') ? sprintf("Password changed for user '%s'.", $users[0])
132
: ($mode eq 'deluser' && $#users == 0) ? sprintf("User '%s' deleted.", $users[0])
133
: ($mode eq 'deluser' && $#users > 0) ? sprintf("Users '%s' deleted.", join "','", @users)
134
: 'Unknown operation...Check error logs.';
135
136
# pass template parameters
137
0
$tmpl_obj->param(
138
'ACTION_STATUS' => $act_stat,
139
'ACTION_MESSAGE' => $act_msg,
140
'HTFILENAME' => $htfile,
141
'IS_WARNINGS' => $#CGI::Carp::WARNINGS + 1,
142
'FORM_METHOD' => $self->param('act_config')->{'_'}->{'form_method'},
143
);
144
145
# return template-generated output
146
0
return $tmpl_obj->output;
147
}
148
149
# perform an operation
150
sub user_op {
151
0
0
0
my $self = shift;
152
153
# get CGI query object
154
0
my $query_obj = $self->query();
155
156
# create lexical copy of mode
157
0
my $user_mode = lc $query_obj->param('mode');
158
159
# if adding or modifying user, check that passwords match
160
0
0
0
if($user_mode eq 'adduser' || $user_mode eq 'changepw') {
161
0
0
if($query_obj->param('pass') ne $query_obj->param('pass_confirm')) {
162
0
die 'passwords did not match';
163
}
164
}
165
166
# load configuration as a hash ref
167
0
$self->param('act_config', load_config( $self->param('config') ) );
168
169
# add new or change existing user/pass
170
0
my @users = $query_obj->param('user');
171
0
0
0
if($user_mode eq 'adduser' || $user_mode eq 'changepw') {
0
172
0
htfile_moduser(
173
$self->param('act_config')->{'_'}->{'htpasswd_command'},
174
$self->param('act_config')->{ $query_obj->param('htfile') }->{'path'},
175
$users[0],
176
$query_obj->param('pass'),
177
$self->param('act_config')->{ $query_obj->param('htfile') }->{'algorithm'}
178
);
179
}
180
# or delete existing user(s)
181
elsif($user_mode eq 'deluser') {
182
0
for my $user (@users) {
183
0
htfile_deluser(
184
$self->param('act_config')->{'_'}->{'htpasswd_command'},
185
$self->param('act_config')->{ $query_obj->param('htfile') }->{'path'},
186
$user
187
);
188
}
189
}
190
191
# generate operation status page from template
192
0
my $tmpl_output = display_status( $self, $user_mode, $query_obj->param('htfile'), @users );
193
194
# return template-generated output
195
0
return $tmpl_output;
196
}
197
198
# load the app configuration, returning a hash reference
199
sub load_config {
200
0
0
0
my $conf_file = shift;
201
202
# if custom configuration not provided, search for a default config file
203
0
0
if(!defined $conf_file) {
204
# expected filename of the config
205
0
my $CONFIG_FILENAME = 'webpasswd.conf';
206
207
# search for config file in current, parent, and /etc directories
208
0
0
$conf_file = (-e "./$CONFIG_FILENAME") ? "./$CONFIG_FILENAME"
0
0
209
: (-e "../$CONFIG_FILENAME") ? "../$CONFIG_FILENAME"
210
: (-e "/etc/$CONFIG_FILENAME") ? "/etc/$CONFIG_FILENAME"
211
: undef;
212
213
# die if config file was not found
214
0
0
if(! defined $conf_file) {
215
0
die "configuration file not found"
216
}
217
}
218
219
# load configuration, or die on error
220
0
0
my $config_obj = Config::Tiny->read($conf_file) or die Config::Tiny::errstr();
221
222
# if no htpasswd command supplied, default to 'htpasswd'
223
0
0
if(!exists $config_obj->{'_'}->{'htpasswd_command'}) {
224
0
$config_obj->{'_'}->{'htpasswd_command'} = 'htpasswd';
225
0
warn "missing 'htpasswd_command' configuration option, using default of 'htpasswd'";
226
}
227
228
# if template path doesnt exist, try root path
229
0
0
if(!exists $config_obj->{'_'}->{'tmpl_path'}) {
230
0
$config_obj->{'_'}->{'tmpl_path'} = '/';
231
}
232
233
# if template path doesnt end with a fore-slash, append one
234
0
0
if(substr($config_obj->{'_'}->{'tmpl_path'}, -1) ne '/') {
235
0
$config_obj->{'_'}->{'tmpl_path'} .= '/';
236
}
237
238
# if form method not provided or not GET, default to POST
239
0
0
0
if(!exists $config_obj->{'_'}->{'form_method'} || uc($config_obj->{'_'}->{'form_method'}) ne 'GET') {
240
0
$config_obj->{'_'}->{'form_method'} = 'POST';
241
}
242
243
# ensure valid attributes for each configured section
244
0
for my $section (keys %{$config_obj}) {
0
245
# if not root section
246
0
0
if($section ne '_') {
247
# if missing path, remove from active config and issue warning
248
0
my $file_path = $config_obj->{$section}->{'path'};
249
0
0
0
if(!defined $file_path || $file_path =~ m/\A\s*\z/ || ! -e $file_path) {
0
250
0
delete $config_obj->{$section};
251
0
warn "invalid path for config block [$section]";
252
0
next;
253
}
254
255
# if missing or invalid algorithm, default to 'crypt' and issue warning
256
0
my $pass_alg = lc $config_obj->{$section}->{'algorithm'};
257
0
0
if($pass_alg !~ m/\s*(?:crypt|md5|sha|plain)\s*/i) {
258
0
warn "invalid password algorithm '$pass_alg' for config block [$section], using 'crypt' instead";
259
0
$pass_alg = 'crypt';
260
}
261
0
$config_obj->{$section}->{'algorithm'} = $pass_alg;
262
}
263
}
264
265
# return config
266
0
return $config_obj;
267
}
268
269
# list the users in a given htfile
270
sub htfile_listusers {
271
0
0
0
my $htfile = shift;
272
273
# declare array to hold usernames
274
0
my @users;
275
276
# read htfile in as text
277
0
0
open(my $HTFILE, '<', $htfile) or die $!;
278
0
my @file = <$HTFILE>;
279
0
close($HTFILE);
280
281
# parse off usernames, add to array
282
0
for my $line (@file) {
283
0
my($user) = split /:/, $line, 2;
284
0
push @users, $user;
285
}
286
287
# return username array
288
0
return @users;
289
}
290
291
# add/modify a user in a given htfile
292
sub htfile_moduser {
293
0
0
0
my($htcmd,$htfile,$user,$pass,$algorithm) = @_;
294
295
# translate algorithm to appropriate flag
296
0
0
$algorithm = ($algorithm eq 'plain') ? 'p'
0
0
0
297
: ($algorithm eq 'md5') ? 'm'
298
: ($algorithm eq 'sha') ? 's'
299
: ($algorithm eq 'crypt') ? 'd'
300
: '';
301
302
# assemble command
303
0
my $command = sprintf "%s -b%s %s %s %s",
304
$htcmd,
305
$algorithm,
306
$htfile,
307
$user,
308
$pass;
309
310
# execute, or die on unsuccessful return value
311
0
0
if(system($command) != 0) {
312
0
die "htpasswd command failed: $?";
313
}
314
315
# return just to be tidy
316
0
return;
317
}
318
319
# delete a user in a given htfile
320
sub htfile_deluser {
321
0
0
0
my($htcmd,$htfile,$user) = @_;
322
323
# assemble command
324
0
my $command = sprintf "%s -D %s %s",
325
$htcmd,
326
$htfile,
327
$user;
328
329
# try to make htpasswd do the work with the -D flag (apache 2.x)
330
0
0
if(system($command) == 0) {
331
0
return 1;
332
}
333
# otherwise, do the damn thing by hand (apache 1.3.x)
334
else {
335
# read in htfile contents
336
0
0
open(my $HTIN, '<', $htfile) or die $!;
337
0
my @file = <$HTIN>;
338
0
close($HTIN);
339
340
# search for, and remove, offending user line
341
0
my $deleted = 0;
342
0
for my $ln (0..$#file) {
343
1
1
9
no warnings; # bypass a puzzling warning of uninitialized value in m//
1
2
1
364
344
0
0
if($file[$ln] =~ m/\A$user\:/) {
345
0
splice @file, $ln, 1;
346
0
$deleted++;
347
}
348
}
349
350
# write changes back to htfile
351
0
0
open(my $HTOUT, '>', $htfile) or die $!;
352
0
print {$HTOUT} @file;
0
353
0
close($HTOUT);
354
355
# set error string
356
0
0
$! = ($deleted) ? undef : "remove of line '$user' failed";
357
358
0
return $deleted;
359
}
360
}
361
362
363
$Web::Passwd::INDEX_TEMPLATE = <<'HTML_CODE';
364
365
366
367
Web Htpasswd Management
368
372
373
374
375
376
377
378
Web Htpasswd Management
379
380
381
382
383
384
385
386
Select Htpasswd File:
387
388
389
390
">
391
392
393
394
395
396
397
398
399
400
401
Warnings were encountered...Please check error log.
402
403
404
405
406
407
408
409
412
HTML_CODE
413
414
$Web::Passwd::VIEW_TEMPLATE = <<'HTML_CODE';
415
416
417
418
Web Htpasswd Management
419
423
424
425
426
427
428
429
Managing Htpasswd File:
430
431
432
433
434
435
436
437
438
439
Add User
440
458
459
460
461
462
463
464
465
466
467
Modify User
468
492
493
494
495
496
497
498
499
500
501
Delete Users
502
518
519
520
521
522
523
Back to Main
524
525
526
Warnings were encountered...Please check error log.
527
528
529
530
531
532
533
534
537
HTML_CODE
538
539
$Web::Passwd::STATUS_TEMPLATE = <<'HTML_CODE';
540
541
542
543
Web Htpasswd Management
544
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
Warnings were encountered...Please check error log.
568
569
570
571
572
573
574
575
578
HTML_CODE
579
580
=head1 NAME
581
582
Web::Passwd - Web-based htpasswd Management
583
584
=head1 VERSION
585
586
Version 0.03
587
588
=cut
589
our $VERSION = "0.03";
590
591
=head1 SYNOPSIS
592
593
Web::Passwd is a web-based utility for managing Apache C files. It uses the L framework, so functionality is encapsulated in the module and very little code is required to create an instance:
594
595
use Web::Passwd;
596
597
my $webapp = Web::Passwd->new();
598
$webapp->run();
599
600
That's it. Drop that script in a web-accessible cgi directory and give it execute permissions, and (assuming a default config file is found), you're good to go. If you'd rather explicity define a configuration file to use, you can pass it through an extra parameter:
601
602
my $webapp = Web::Passwd->new( PARAMS => { config => '/home/evan/custom_webpasswd.conf' } );
603
604
=head1 CONFIGURATION
605
606
If not explicitly provided, a configuration file will be searched for in the following locations (in order). If a valid configuration file is not found, the script will die with errors.
607
608
./webpasswd.conf (the current directory)
609
../webpasswd.conf (the parent directory)
610
/etc/webpasswd.conf
611
612
The configuration file can be used to specify a directory of templates in the L format. If no templates are found, default templates are used (see the C directory of the distribution).
613
614
tmpl_path = /var/www/cgi-bin/webpasswd/
615
616
The C command can also be specified. If no C command is provided, the default is used. Note that, on some systems, you must specify the I path to the C binary.
617
618
htpasswd_command = htpasswd
619
620
The configuration file can specify whether to use the C (data encoded into the URL) or C (data encoded into the message body) form request method. Defaults to using the generally more secure C.
621
622
form_method = POST
623
624
The configuration file should also contain a section for each htpasswd file it will be used to maintain, using the following format:
625
626
[Descriptive Name]
627
path = /system/path/to/passwdfile
628
algorithm = {crypt|md5|sha|plain}
629
630
B The default algorithm Apache uses is C under Linux, and C under Windows.
631
632
B Enclosing values in quotes within the config file does not have the expected effect! It simply includes the literal quote characters in the config value.
633
634
=head1 SECURITY
635
636
It is *imperitive* that the Web::Passwd instance script itself be htpasswd protected, as it includes no access control mechanism.
637
638
Understand that putting the ability to manage htpasswd files via a web-based utility carries an inherent security risk, in that anyone who gains access to the utility is potentially given access to any of the managed htpasswd-protected resources.
639
640
Any htpasswd files to be managed with this utility MUST be owned by whatever user apache runs as. Usually, this is 'apache' or 'nobody'.
641
642
=head1 COMPATABILITY
643
644
This was written expressly for Apache webserver 1.3 or higher running under Linux. However, there is nothing as far as I am aware that would prevent execution on a higher version of Apache, or on Apache under Windows.
645
646
=head1 DEPENDENCIES
647
648
A Perl version of 5.6.1 or higher is recommended, and the following modules are required:
649
650
CGI::Application
651
Config::Tiny
652
HTML::Template
653
654
=head1 AUTHOR
655
656
Evan Kaufman, C<< >>
657
658
=head1 SUPPORT
659
660
You can find documentation for this module with the perldoc command.
661
662
perldoc Web::Passwd
663
664
=head1 ACKNOWLEDGEMENTS
665
666
Written for BCD Music Group.
667
668
=head1 COPYRIGHT & LICENSE
669
670
Copyright 2007 Evan Kaufman, all rights reserved.
671
672
This program is free software; you can redistribute it and/or modify it
673
under the same terms as Perl itself.
674
675
=cut
676
677
# we're a good little module
678
1;