117 if ($opt_kill) { |
118 if ($opt_kill) { |
118 $opt_auth = 0; |
119 $opt_auth = 0; |
119 $opt_ssl = 0; |
120 $opt_ssl = 0; |
120 } |
121 } |
121 |
122 |
|
123 foreach ($opt_ssl_key, $opt_ssl_cert) { |
|
124 $_ = abs_path($_) if defined; |
|
125 } |
|
126 |
|
127 ### $opt_ssl_key |
|
128 ### $opt_ssl_cert |
|
129 |
122 $authdata = new Authen::hlog(filename => $opt_htpasswd, realm => $opt_realm) |
130 $authdata = new Authen::hlog(filename => $opt_htpasswd, realm => $opt_realm) |
123 if $opt_auth; |
131 if $opt_auth; |
124 |
132 |
125 if (defined($logdir = find_writable_dir(@$logdir))) { |
133 if (defined($logdir = find_writable_dir(@$logdir))) { |
126 $access = sprintf $$access, $logdir; |
134 $access = sprintf $$access, $logdir; |
170 $file = getcwd() . "/$file" if $file !~ /^\//; |
178 $file = getcwd() . "/$file" if $file !~ /^\//; |
171 $FILE{$tag} = $file; |
179 $FILE{$tag} = $file; |
172 } |
180 } |
173 |
181 |
174 # start the listener |
182 # start the listener |
175 my $listener = |
183 # my $listener = |
176 $opt_ssl |
184 # $opt_ssl |
177 ? new IO::Socket::SSL( |
185 # ? new IO::Socket::SSL( |
178 LocalAddr => $opt_addr, |
186 # LocalAddr => $opt_addr, |
179 LocalPort => $opt_port, |
187 # LocalPort => $opt_port, |
180 Proto => "tcp", |
188 # Proto => "tcp", |
181 Listen => 1, |
189 # Listen => 1, |
182 ReuseAddr => 1, |
190 # ReuseAddr => 1, |
183 SSL => $opt_ssl, |
191 # SSL => $opt_ssl, |
184 SSL_key_file => $opt_ssl_key, |
192 # SSL_key_file => $opt_ssl_key, |
185 SSL_cert_file => $opt_ssl_cert, |
193 # SSL_cert_file => $opt_ssl_cert, |
186 #debug => $opt_debug |
194 # #debug => $opt_debug |
187 ) |
195 # ) |
188 : new IO::Socket::INET( |
196 # : new IO::Socket::INET( |
|
197 # LocalAddr => $opt_addr, |
|
198 # LocalPort => $opt_port, |
|
199 # Proto => "tcp", |
|
200 # Listen => 1, |
|
201 # ReuseAddr => 1, |
|
202 # #debug => $opt_debug, |
|
203 # ); |
|
204 |
|
205 my $listener = new IO::Socket::INET( |
189 LocalAddr => $opt_addr, |
206 LocalAddr => $opt_addr, |
190 LocalPort => $opt_port, |
207 LocalPort => $opt_port, |
191 Proto => "tcp", |
208 Proto => "tcp", |
192 Listen => 1, |
209 Listen => 1, |
193 ReuseAddr => 1, |
210 ReuseAddr => 1, |
194 #debug => $opt_debug, |
211 ) or die "Can't create listener: $!\n"; |
195 ); |
|
196 |
212 |
197 # go daemon |
213 # go daemon |
198 chdir("/") or die "Can't chdir to /: $!\n"; |
214 chdir("/") or die "Can't chdir to /: $!\n"; |
199 |
215 |
200 if ($opt_daemon) { |
216 if ($opt_daemon) { |
247 |
263 |
248 my $pid = fork(); |
264 my $pid = fork(); |
249 die "Can't fork: $!\n" if not defined $pid; |
265 die "Can't fork: $!\n" if not defined $pid; |
250 if ($pid == 0) { |
266 if ($pid == 0) { |
251 $SIG{CHLD} = "DEFAULT"; |
267 $SIG{CHLD} = "DEFAULT"; |
252 $listener->close(SSL_no_shutdown => 1); |
268 $listener->close(); |
|
269 if ($opt_ssl) { |
|
270 $client = IO::Socket::SSL->new_from_fd( |
|
271 $client, |
|
272 SSL_server => 1, |
|
273 SSL_key_file => $opt_ssl_key, |
|
274 SSL_cert_file => $opt_ssl_cert, |
|
275 ); |
|
276 $client->start_SSL; |
|
277 } |
253 handle_request($client); |
278 handle_request($client); |
254 exit 0; |
279 exit 0; |
255 } |
280 } |
256 $client->close(SSL_no_shutdown => 1); |
281 $client->close(); |
257 |
282 |
258 # maintenance of logfiles |
283 # maintenance of logfiles |
259 if (-s $access > $maxlogsize) { |
284 if (-s $access > $maxlogsize) { |
260 rename $access, "$access.1"; |
285 rename $access, "$access.1"; |
261 log_open($access); |
286 log_open($access); |
462 } |
488 } |
463 |
489 |
464 # PACKAGES |
490 # PACKAGES |
465 { |
491 { |
466 |
492 |
467 package IO::Socket::hlog; |
|
468 |
|
469 use IO::Socket::INET; |
|
470 use IO::Socket::SSL; |
|
471 |
|
472 our (@ISA, $DEBUG); |
|
473 |
|
474 sub new { |
|
475 |
|
476 my $class = shift; |
|
477 |
|
478 my %args = @_; |
|
479 my $ssl = delete $args{SSL}; |
|
480 |
|
481 if ($ssl) { |
|
482 |
|
483 @ISA = qw(IO::Socket::SSL); |
|
484 $IO::Socket::SSL::DEBUG = $DEBUG ? 3 : 0; |
|
485 |
|
486 } |
|
487 else { |
|
488 |
|
489 %args = _delete_ssl_args(%args); |
|
490 @ISA = qw(IO::Socket::INET); |
|
491 |
|
492 } |
|
493 |
|
494 my $self; |
|
495 unless ($self = $class->SUPER::new(%args)) { |
|
496 |
|
497 return; |
|
498 |
|
499 } |
|
500 |
|
501 print "$class: $self created\n" if $DEBUG; |
|
502 |
|
503 return $self; |
|
504 |
|
505 } |
|
506 |
|
507 sub close { |
|
508 |
|
509 my $self = shift; |
|
510 print "$self: closing\n" if $DEBUG; |
|
511 |
|
512 my %args = @_; |
|
513 |
|
514 %args = _delete_ssl_args(%args) unless $self->_is_ssl; |
|
515 |
|
516 return $self->SUPER::close(%args); |
|
517 |
|
518 } |
|
519 |
|
520 sub errstr { |
|
521 |
|
522 return IO::Socket::SSL::errstr if _is_ssl(); |
|
523 |
|
524 return $@; |
|
525 |
|
526 } |
|
527 |
|
528 sub _delete_ssl_args { |
|
529 |
|
530 my %args = @_; |
|
531 map { delete $args{$_} if /^SSL/; } keys %args; |
|
532 return %args; |
|
533 |
|
534 } |
|
535 |
|
536 sub _is_ssl { |
|
537 |
|
538 my $self = shift; |
|
539 return $ISA[0] eq "IO::Socket::SSL"; |
|
540 |
|
541 } |
|
542 } |
|
543 |
|
544 { |
|
545 |
|
546 # authentication |
493 # authentication |
547 package Authen::hlog; |
494 package Authen::hlog; |
548 |
495 |
549 use Crypt::PasswdMD5; |
496 use Crypt::PasswdMD5; |
550 use Digest::SHA1 qw(sha1_base64); |
497 use Digest::SHA1 qw(sha1_base64); |