30 use POSIX qw(); |
30 use POSIX qw(); |
31 use String::MkPasswd qw(); |
31 use String::MkPasswd qw(); |
32 |
32 |
33 BEGIN { |
33 BEGIN { |
34 |
34 |
35 our ($VERSION, @ISA, @EXPORT_OK); |
35 our ( $VERSION, @ISA, @EXPORT_OK ); |
36 use Exporter; |
36 use Exporter; |
37 |
37 |
38 # set the version for version checking |
38 # set the version for version checking |
39 $VERSION = 0.1; |
39 $VERSION = 0.1; |
40 |
40 |
41 @ISA = qw(Exporter); |
41 @ISA = qw(Exporter); |
42 @EXPORT_OK = qw(readconfig mkpasswd useradd userdel userexpiry usage); |
42 @EXPORT_OK = qw(readconfig mkpasswd useradd userdel userexpiry usage); |
43 } |
43 } |
44 |
44 |
45 sub usage { |
45 sub usage { |
46 |
46 |
47 use Pod::Usage; |
47 use Pod::Usage; |
48 use Pod::Find qw(pod_where); |
48 use Pod::Find qw(pod_where); |
49 |
49 |
50 pod2usage( -input => pod_where({-inc => 1}, __PACKAGE__), @_ ); |
50 pod2usage( -input => pod_where( { -inc => 1 }, __PACKAGE__ ), @_ ); |
51 |
51 |
52 } |
52 } |
53 |
53 |
54 sub readconfig { |
54 sub readconfig { |
55 |
55 |
56 my $conf = new AppConfig(qw( |
56 my $conf = new AppConfig( |
57 expiry=i |
57 qw( |
58 expiry_min=i |
58 expiry=i |
59 expiry_max=i |
59 expiry_min=i |
60 dav_base=s |
60 expiry_max=i |
61 htpasswd=s |
61 dav_base=s |
62 conf_d=s |
62 htpasswd=s |
63 www_user=s |
63 conf_d=s |
64 www_group=s |
64 www_user=s |
65 master_user=s) |
65 www_group=s |
|
66 master_user=s) |
66 ) or die 'Failed to read config!'; |
67 ) or die 'Failed to read config!'; |
67 $conf->file($_) for grep -e, map "$_/ius-dav-htpasswd.conf", qw(/etc/ius-dav-htpasswd /usr/local/etc/ius-dav-htpasswd ~/.ius-dav-htpasswd ./ius-dav-htpasswd); |
68 $conf->file($_) |
|
69 for grep -e, map "$_/ius-dav-htpasswd.conf", |
|
70 qw(/etc/ius-dav-htpasswd /usr/local/etc/ius-dav-htpasswd ~/.ius-dav-htpasswd ./ius-dav-htpasswd); |
68 return { $conf->varlist('.') }; |
71 return { $conf->varlist('.') }; |
69 |
72 |
70 } |
73 } |
71 |
74 |
72 sub validate { |
75 sub validate { |
73 |
76 |
74 my ($conf, $user, $expiry) = @_; |
77 my ( $conf, $user, $expiry ) = @_; |
75 |
78 |
76 return unless $user =~ /^[[:alpha:]_]+$/; |
79 return unless $user =~ /^[[:alpha:]_]+$/; |
77 |
80 |
78 if (defined $expiry) { |
81 if ( defined $expiry ) { |
79 return unless $expiry =~ /^[0-9]+$/; |
82 return unless $expiry =~ /^[0-9]+$/; |
80 return unless $expiry >= $conf->{expiry_min} and $expiry <= $conf->{expiry_max}; |
83 return |
|
84 unless $expiry >= $conf->{expiry_min} |
|
85 and $expiry <= $conf->{expiry_max}; |
81 } |
86 } |
82 |
87 |
83 return 1; |
88 return 1; |
84 |
89 |
85 } |
90 } |
86 |
91 |
87 sub useradd { |
92 sub useradd { |
88 |
93 |
89 my ($conf, $user, $pass, $expiry) = @_; |
94 my ( $conf, $user, $pass, $expiry ) = @_; |
90 |
95 |
91 for (qw(expiry expiry_min expiry_max dav_base htpasswd conf_d www_user www_group)) { |
96 for ( |
|
97 qw(expiry expiry_min expiry_max dav_base htpasswd conf_d www_user www_group) |
|
98 ) |
|
99 { |
92 die "Can't determine '$_' - please check configuration" |
100 die "Can't determine '$_' - please check configuration" |
93 unless defined $conf->{$_}; |
101 unless defined $conf->{$_}; |
94 } |
102 } |
95 |
103 |
96 $expiry = $conf->{expiry} unless defined $expiry and $expiry ne ''; |
104 $expiry = $conf->{expiry} unless defined $expiry and $expiry ne ''; |
97 die 'Invalid input' unless validate $conf, $user, $expiry; |
105 die 'Invalid input' unless validate $conf, $user, $expiry; |
98 |
106 |
99 my $user_dir = "$conf->{dav_base}/$user"; |
107 my $user_dir = "$conf->{dav_base}/$user"; |
100 mkdir "$user_dir" or die "Can't mkdir '$user_dir': $!"; |
108 mkdir "$user_dir" or die "Can't mkdir '$user_dir': $!"; |
101 |
109 |
102 my ($www_user, $www_group) = @{$conf}{qw(www_user www_group)}; |
110 my ( $www_user, $www_group ) = @{$conf}{qw(www_user www_group)}; |
103 my $www_uid = getpwnam $www_user or die "Can't getpwnam '$www_user'"; |
111 my $www_uid = getpwnam $www_user or die "Can't getpwnam '$www_user'"; |
104 my $www_gid = getgrnam $www_group or die "Can't getgrnam '$www_group'"; |
112 my $www_gid = getgrnam $www_group or die "Can't getgrnam '$www_group'"; |
105 chown $www_uid, $www_gid, "$user_dir" or die "Can't chown, '$www_uid', '$www_gid', '$user_dir': $!"; |
113 chown $www_uid, $www_gid, "$user_dir" |
|
114 or die "Can't chown, '$www_uid', '$www_gid', '$user_dir': $!"; |
106 |
115 |
107 my $htpasswd_file = $conf->{htpasswd}; |
116 my $htpasswd_file = $conf->{htpasswd}; |
108 unless (-e $htpasswd_file ) { |
117 unless ( -e $htpasswd_file ) { |
109 open H, '>>', $htpasswd_file or die "Can't create '$htpasswd_file': $!"; |
118 open H, '>>', $htpasswd_file or die "Can't create '$htpasswd_file': $!"; |
110 close H; |
119 close H; |
111 } |
120 } |
112 |
121 |
113 my $htpasswd = new Apache::Htpasswd $htpasswd_file; |
122 my $htpasswd = new Apache::Htpasswd $htpasswd_file; |
114 $htpasswd->htpasswd($user, $pass) |
123 $htpasswd->htpasswd( $user, $pass ) |
115 or die $htpasswd->error; |
124 or die $htpasswd->error; |
116 $htpasswd->writeInfo($user, time + 24 * 60 * 60 * $expiry) |
125 $htpasswd->writeInfo( $user, time + 24 * 60 * 60 * $expiry ) |
117 or die $htpasswd->error; |
126 or die $htpasswd->error; |
118 |
127 |
119 my $master_user = $conf->{master_user}; |
128 my $master_user = $conf->{master_user}; |
120 my $conf_file = "$conf->{conf_d}/$user.conf"; |
129 my $conf_file = "$conf->{conf_d}/$user.conf"; |
121 open C, '>', $conf_file or die "Can't open '$conf_file': $!"; |
130 open C, '>', $conf_file or die "Can't open '$conf_file': $!"; |
122 print C <<EOC; |
131 print C <<EOC; |
123 <Directory "$user_dir"> |
132 <Directory "$user_dir"> |
124 Dav On |
133 Dav On |
125 Order Allow,Deny |
134 Order Allow,Deny |
132 </Directory> |
141 </Directory> |
133 EOC |
142 EOC |
134 close C; |
143 close C; |
135 |
144 |
136 0 == system qw(apache2ctl graceful) |
145 0 == system qw(apache2ctl graceful) |
137 or die "Can't 'apache2ctl graceful'!"; |
146 or die "Can't 'apache2ctl graceful'!"; |
138 |
147 |
139 return $pass; |
148 return $pass; |
140 |
149 |
141 } |
150 } |
142 |
151 |
143 sub mkpasswd { return String::MkPasswd::mkpasswd; } |
152 sub mkpasswd { return String::MkPasswd::mkpasswd; } |
144 |
153 |
145 sub userdel { |
154 sub userdel { |
146 |
155 |
147 my ($conf, $user) = @_; |
156 my ( $conf, $user ) = @_; |
148 |
157 |
149 my $rc; |
158 my $rc; |
150 |
159 |
151 for (qw(dav_base htpasswd conf_d)) { |
160 for (qw(dav_base htpasswd conf_d)) { |
152 die "Can't determine '$_' - please check configuration" |
161 die "Can't determine '$_' - please check configuration" |
153 unless defined $conf->{$_}; |
162 unless defined $conf->{$_}; |
154 } |
163 } |
155 |
164 |
156 # avoid 'Found = in conditional, should be ==' warnings |
165 # avoid 'Found = in conditional, should be ==' warnings |
157 no warnings qw(syntax); |
166 no warnings qw(syntax); |
158 my $user_dir = "$conf->{dav_base}/$user"; |
167 my $user_dir = "$conf->{dav_base}/$user"; |
159 my $err; |
168 my $err; |
160 rmtree($user_dir, error => $err) |
169 rmtree( $user_dir, error => $err ) |
161 or $rc = -1 and defined $err and warn "Errors occurred during rmtree '$user_dir': ", @{$err}; |
170 or $rc = -1 |
|
171 and defined $err |
|
172 and warn "Errors occurred during rmtree '$user_dir': ", @{$err}; |
162 |
173 |
163 my $htpasswd_file = $conf->{htpasswd}; |
174 my $htpasswd_file = $conf->{htpasswd}; |
164 my $htpasswd = new Apache::Htpasswd $htpasswd_file; |
175 my $htpasswd = new Apache::Htpasswd $htpasswd_file; |
165 $htpasswd->htDelete($user) |
176 $htpasswd->htDelete($user) |
166 or $rc = -1 and warn "Can't htdelete '$user': ", $htpasswd->error; |
177 or $rc = -1 and warn "Can't htdelete '$user': ", $htpasswd->error; |
167 |
178 |
168 my $conf_file = "$conf->{conf_d}/$user.conf"; |
179 my $conf_file = "$conf->{conf_d}/$user.conf"; |
169 unlink $conf_file |
180 unlink $conf_file |
170 or $rc = -1 and warn "Can't unlink '$conf_file': $!"; |
181 or $rc = -1 and warn "Can't unlink '$conf_file': $!"; |
171 |
182 |
172 0 == system qw(apache2ctl graceful) |
183 0 == system qw(apache2ctl graceful) |
173 or $rc =-1 and warn "Can't 'apache2ctl graceful'!"; |
184 or $rc = -1 and warn "Can't 'apache2ctl graceful'!"; |
174 |
185 |
175 } |
186 } |
176 |
187 |
177 sub userexpiry { |
188 sub userexpiry { |
178 |
189 |
179 my ($conf) = @_; |
190 my ($conf) = @_; |
180 |
191 |
181 for (qw(htpasswd)) { |
192 for (qw(htpasswd)) { |
182 die "Can't determine '$_' - please check configuration" |
193 die "Can't determine '$_' - please check configuration" |
183 unless defined $conf->{$_}; |
194 unless defined $conf->{$_}; |
184 } |
195 } |
185 |
196 |
186 my $htpasswd_file = $conf->{htpasswd}; |
197 my $htpasswd_file = $conf->{htpasswd}; |
187 my $htpasswd = new Apache::Htpasswd $htpasswd_file; |
198 my $htpasswd = new Apache::Htpasswd $htpasswd_file; |
188 my @users = $htpasswd->fetchUsers |
199 my @users = $htpasswd->fetchUsers |
189 or die "Can't fetch htuser list: ", $htpasswd->error; |
200 or die "Can't fetch htuser list: ", $htpasswd->error; |
190 my $now = time; |
201 my $now = time; |
191 |
202 |
192 for my $u (@users) { |
203 for my $u (@users) { |
193 if (my $e = $htpasswd->fetchInfo($u)) { |
204 if ( my $e = $htpasswd->fetchInfo($u) ) { |
194 userdel($conf, $u) or warn "Can't 'userdel $conf, $u'\n" if $now >= $e; |
205 userdel( $conf, $u ) |
195 } else { |
206 or warn "Can't 'userdel $conf, $u'\n" |
|
207 if $now >= $e; |
|
208 } |
|
209 else { |
196 warn "Can't get expiry for '$u': ", $htpasswd->error, "\n"; |
210 warn "Can't get expiry for '$u': ", $htpasswd->error, "\n"; |
197 } |
211 } |
198 } |
212 } |
199 |
213 |
200 } |
214 } |