#!/usr/bin/perl use IO::Socket; use Time::localtime; # diretorio onde todas as paginas serao gravadas, sem / no final $root = "/usr/local/webpages"; # porta na qual serao atendidas as requisicoes $port = 8080; # numero maximo de requisicao de conexoes (antes de serem recusadas) $maxconn = SOMAXCONN; $server = IO::Socket::INET->new(Proto=>"tcp", LocalPort=>$port, Listen=>$maxconn, Reuse=>1) or die "Can't setup server\n"; print "Server inited\nPort: $port\nMaxconnections:$maxconn\nFileroot: $root\n\n"; # binmode nao tem efeito em UNIX, mas em Win32 ha diferenca entre arquivos texto # e binario, e binmode define o arquivo para o modo binario binmode(STDOUT); while ($client = $server->accept) { $client->autoflush(1); # aprimeira linha de uma requisicao HTTP 1.0/1.1 deve possuir o formato "GET document HTTP/1.x" @header = split(' ', <$client>); $url = $header[1]; $httpver = $header[2]; # se recebeu um cabecalho valido, inicia a transacao if ($header[0] eq "GET" && ($httpver eq "HTTP/1.0" || $httpver eq "HTTP/1.1")) { # se o documento for um diretorio, acrescenta o nome de arquivo padrao (index.html) if (rindex($url, "/") == length($url)-length("\n")) { $url.= "index.html" } if (open(FILE, $root.$url)) { binmode(FILE); # envia o cabecalho HTTP print $client "$httpver 200 OK\n\n"; # envia o arquivo em seguida while () { print $client $_ } close(FILE); # imprimie um registro da transacao (log) print "[", $client->peerhost, "] ", ctime, " enviou \"$url\"\n"; } else { # se o arquivo nao estiver disponivel ou nao existir # envia uma mensagem com o codigo de erro print $client "$httpver 404 File Not Found\n\n"; print $client "404 File Not Found\n"; print $client "

Arquivo Nao Encontrado

\n"; print $client "A URL requisitada $url nao foi encontrada neste servidor.\n"; print $client ""; # imprime o registro da transacao (log) print "[", $client->peerhost, "] ", ctime, " falhou \"$url\"\n"; } } close $client; } close $server;