404 kódú hiba

#!/usr/bin/perl -Tw # # Ez egy apró kis teszt proxy szerver. Azon a gépen kell # installálni, amelyiken a böngésző fut, és kizárólag arra # való, hogy tesztelni lehessen, hogy a böngésző, és a # szerver között milyen http üzenetek mennek. # # N I N C S # # - remote proxy # # use Socket; $error_404 = < 404 kódú hiba Nincs meg az oldal

A kívánt oldal nem található meg. END404 $hostname = 'localhost'; $port = 8080; # proxy port, amelyiken hallgatódzik az alkalmazás # lefoglaljuk a szerver portot, amelyiken a kis proxy-nk hallgatódzik $proto = getprotobyname('tcp'); socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!"; bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!"; listen(Server,SOMAXCONN) || die "listen: $!"; # # most le van foglalva a port, és várjuk a klienst # újra, és újra # while(1){ print "----------------------------------------------\n"; $paddr = accept(Client,Server); binmode Client; # bináris mód szükséges ha Windows NT alatt fut a program # a Client socket ne legyen pufferelve $oldfh = select(Client); $| = 1; select($oldfh); my($port,$iaddr) = sockaddr_in($paddr); my $name = gethostbyaddr($iaddr,AF_INET); # beolvassuk a http parancsot. $http_command = ; print "^ $http_command"; # ez a parancs # GET http://yourhost.domain.com:80/path/path/path/file?cgiparaméter HTTP/1.0 # vagy # POST http://yourhost.domain.com:80/path/path/path/file?cgiparaméter HTTP/1.0 # alakú if( $http_command =~ /^(GET|POST)\s+(.*?)\s+HTTP/i ){ $method = uc $1; $URL = $2; } @http_header_lines = (); $ContentLength = 0; while( ){ push @http_header_lines , $_; if( /Content-Length:\s*(\d+)\s*/ ){ $ContentLength = $1; } print "^ $_"; last if $_ eq "\r\n" || $_ eq "\n" || $_ eq "\r"; } $post_param = ''; if( $method eq 'POST' ){ if( $ContentLength > 0 ){ $i=read(Client,$Buffer,$ContentLength); $post_param .= $Buffer; print "^ $Buffer"; }else{ for( $i=read(Client,$Buffer,1024) ; $i > 0 ; $i=read(Client,$Buffer,1024)){ $post_param .= $Buffer; print "^ $Buffer"; } } } if ($URL =~ m#^http://([\w-\.]+):?(\d*)(/.*)?#) { $host = $1; #URL host $port = $2; #URL port $path = $3; #URL path } $path = '/' if $path eq "" ; $port = 80 if $port eq "" ; $sockaddr = 'S n a4 x8'; ($name,$aliases,$proto) = getprotobyname('tcp'); ($name,$aliases,$type,$len,$thisaddr) = gethostbyname($hostname); if( ! (($name,$aliases,$type,$len,$thataddr) = gethostbyname($host)) ){ print "ERROR: can not get host $host by name\n"; print Client $error_404; close Client; next; } $this = pack($sockaddr, AF_INET, 0, $thisaddr); $that = pack($sockaddr, AF_INET, $port, $thataddr); # Make the socket filehandle. socket(S, AF_INET, SOCK_STREAM, $proto) || die "socket $!"; # Give the socket an address bind(S, $this) || die "bind $!"; if( ! connect(S,$that) ){ print "ERROR: can not connect to $host\n"; print Client $error_404; close Client; next; } $oldfh = select(S); $| = 1; select($oldfh); binmode S; print S "$method $path HTTP/1.0\n"; while( @http_header_lines ){ print S pop @http_header_lines; } # ez a fejléc és a http test közötti üres sor print S "\n"; print S $post_param; $response = ; print Client $response; chomp $response; print "V $response\n"; my($protocol, $status) = split(/ /, $response); $ContentLength = 0; while(){ print Client $_; chomp; last if $_ eq chr(13) || $_ eq ""; print "V $_\n"; #print the header lines #take the length to recongize that all the file arrived if( /Content-Length:\s*(\d+)\s*/ ){ $ContentLength = $1; } } if( $ContentLength > 0 ){ $i=read(S,$Buffer,$ContentLength); print Client $Buffer; }else{ for( $i=read(S,$Buffer,1024) ; $i > 0 ; $i=read(S,$Buffer,1024)){ print Client $Buffer; } } close S; close Client; }