package Web; use strict; use warnings; use Exporter; use IO::File; our @ISA = qw/Exporter/; our @EXPORT = qw/docroot handle_connection/; my $DOCUMENT_ROOT = '/home/ghw/myperl/Net/15'; my $CRLF = "\015\012"; sub handle_connection { my $c = shift; my ( $fh, $type, $length, $url, $method); local $/ = "$CRLF"; my $request = <$c>; return invalid_request($c) unless ($method, $url ) = $request =~ m!^(GET|HEAD) (/.*) HTTP/1\.[01]!; return not_found($c) unless ($fh, $type, $length) = lookup_file($url); return redirect($c, "$url/") if $type eq 'directory'; print $c "HTTP/1.0 200 OK$CRLF"; print $c "Content-length: $length$CRLF"; print $c "Content-type: $type$CRLF"; print $c "$CRLF"; return unless $method eq 'GET'; my $buffer; while ( read($fh, $buffer, 1024) ) { print $c $buffer; } close $fh; } sub lookup_file { my $url = shift; my $path = $DOCUMENT_ROOT.$url; $path =~ s/\?.*$//g; $path =~ s/#.*$//g; $path = 'index.html' if $path =~ m!/$!; return if $path =~ m!/\.\./!; return ( undef, 'directory', undef) if -d $path; my $type = 'text/plain'; $type = 'text/html' if $path =~ /\.html$/i; $type = 'image/gif' if $path =~ /\.gif$/i; $type = 'image/jpeg' if $path =~ /\.jpg$/i; return unless my $length = (stat(_))[7]; return unless my $fh = IO::File->new($path, "<"); return ($fh, $type, $length); } sub redirect { my ($c, $url ) = @_; my $host = $c->sockhost; my $port = $c->sockport; my $move_to = "http://$host:$port$url"; print $c "HTTP/1.0 301 Moved permanently$CRLF"; print $c "Location:$move_to$CRLF"; print $c "Content-type:text/html$CRLF$CRLF"; print $c < 301 Moved

Moved

here END } sub invalid_request { my $c = shift; print $c "HTTP/1.0 400 Bad Request$CRLF"; print $c "Content-type:text/html$CRLF$CRLF"; print $c < 400 Bad Request

Bad Request 400

END } sub not_found { my $c = shift; print $c "HTTP/1.0 404 not found$CRLF"; print $c "Content-type:text/html$CRLF$CRLF"; print $c < 404 not found

not found 404

END } sub docroot { $DOCUMENT_ROOT = shift if @_; return $DOCUMENT_ROOT; } 1;