#!/usr/bin/env perl # devilzc0de.org (c) 2012 use Socket; $port = 13123; $protocol=getprotobyname('tcp'); socket(S,&PF_INET,&SOCK_STREAM,$protocol) || die; setsockopt(S,SOL_SOCKET,SO_REUSEADDR,1); bind (S,sockaddr_in($port,INADDR_ANY)) || die; listen (S,3) || die; while(1){ accept (CONN,S); $req=; chomp($req); $req=~s/\r//g; $req =~ s/\%([A-Fa-f0-9]{2})/pack('C', hex($1))/seg; print $req."\r\n"; $headers = "HTTP/1.1 200 OK\r\n"; $headers .= "Server: Perl\r\n"; $target = $req; if($req =~ /GET .* HTTP.*/){ $target =~ s/GET\ //; $target =~ s/\ HTTP.*//; $resp = ""; if(-d $target){ if(!($target =~ /.*\/+$/)){ $target = $target."/"; } $resp = " Directory listing for ".$target."

Directory listing for ".$target."

"; $conlen = length($resp); $contype = "text/html"; print "Dir : ".$target."\r\n"; } elsif(-f $target){ $conlen = -s $target; $contype = "text/plain"; print "File : ".$target." (".$conlen.")\r\n"; } print "contype : ".$contype."\r\n"; print "conlen : ".$conlen."\r\n"; $headers .= "Content-Type: ".$contype."\r\n"; $headers .= "Content-Length: ".$conlen."\r\n"; print CONN $headers."\r\n"; if(-d $target){ print CONN $resp; } elsif(-f $target){ if(open(FILE,$target)){ binmode FILE; while (($n = read FILE, $data, 1024) != 0) { print CONN $data; } close(FILE); } } } close CONN; } exit 0;