24
02/11
22:55
Some Perl to redirect HTTP requests
After almost a year without publishing a single post, it seems this week I’m going to beat all my records.
A week ago, I wanted to prank my brother for a while. Nothing sophisticated… just some Iptables rules, Tinyproxy and HTTP magic. To go ahead with my evil plans, I needed “something” able to redirect a HTTP request. Actually, there are several ways to do that: Apache redirects, Tornado, Netcat* and so on. These alternatives are fast, bulletproof and time-saving, but not fun.
As many of you probably know, I didn’t get a job yet. That necessary means that I’ve got plenty of free time to waste. So… what did I do? I wrote some Perl and today I’m publishing the source code just in case someone finds it useful somehow. Like the previous entry, it’s published in the public domain.
The script just collects connections, issues 301 back (Moved Permanently) and sets Location to the URI specified as a command line argument (option -u). It lacks some security checks (left as an exercise to the reader) but it does what it is supposed to do. You may likely spot some silly bugs as I haven’t spent much time reading it again. Reports are welcome!
For those wondering, the prank was a big success. I’m afraid I can’t spare any detail by now but it turns out my bro is still thinking that his computer has been cracked.
Example invocation:
$ perl redir.pl -p 7070 -v -t 3 -u http://31337.pl
2011/02/24 21:41:54 Listening on port 7070
2011/02/24 21:41:54 Redirecting HTTP requests to: ‘http://31337.pl’
2011/02/24 21:41:54 3 thread(s) working under the hood
…
And finally the source code:
use warnings; use threads; use Thread::Queue; use POSIX; use IO::Socket::INET; use HTTP::Request; use HTTP::Status qw(:constants status_message); use Getopt::Long; use DateTime::Format::HTTP; use Data::Validate::URI qw(is_http_uri); use Log::Log4perl qw(:easy); use constant MAX_THREADS => 10; use constant MAX_LEN_HEADERS_BUFFER => 8*1024; use constant DEFAULT_REDIRECT_URI => "http://www.example.org"; use constant DEFAULT_PORT => 80; use constant DEFAULT_POOL_SIZE => 3; my $redir_uri = DEFAULT_REDIRECT_URI; my $server_port = DEFAULT_PORT; my $thread_pool_size = DEFAULT_POOL_SIZE; my $verbose; GetOptions('url=s' => \$redir_uri, 'port=i' => \$server_port, 'threads=i' => \$thread_pool_size, 'verbose' => \$verbose) or exit -1; die "Invalid redirect URI (e.g. http://www.example.org)\n" unless is_http_uri($redir_uri); die "Invalid port (e.g. 8080)\n" unless 0 < $server_port && $server_port < 2**16; die "Invalid pool size (should be in [1..".MAX_THREADS."])\n" unless 0 < $thread_pool_size && $thread_pool_size <= MAX_THREADS; Log::Log4perl->easy_init( level => $verbose? $DEBUG : $INFO ); my $pending = Thread::Queue->new(); my $lsock = IO::Socket::INET->new( LocalPort => $server_port, Proto => 'tcp', Listen => 1, Reuse => 1 ) or die "Couldn't bind listening socket ($!)\n"; INFO("Listening on port $server_port\n"); INFO("Redirecting HTTP requests to: '$redir_uri'\n"); my @workers = (); for (1..$thread_pool_size) { if ($thread = threads->create("worker")) { push(@workers, $thread); } } DEBUG(sprintf("%d thread(s) working under the hood\n", $#workers+1)); # Set a tidy shutdown just in case an external agent SIG{INT,TERM}s the process $SIG{'INT'} = $SIG{'TERM'} = sub { # Dirty hack. threads->kill() does not wake up the thread :( for (1..@workers) { $pending->enqueue(-1); } for (@workers) { DEBUG(sprintf("Worker %d terminated: %d clients served\n", $_->tid, $_->join())); } close($lsock); exit 0; }; while(1) { my $csock = $lsock->accept() or next; $pending->enqueue(POSIX::dup(fileno $csock)); DEBUG(sprintf("New client enqueued: %s:%s\n", $csock->peerhost, $csock->peerport)); close($csock); } sub worker { my $clients_served = 0; while(my $fd = $pending->dequeue) { # API promises thread safety :-) if ($fd == -1) { return $clients_served; } my $sock = IO::Socket::INET->new_from_fd($fd, "r+"); DEBUG(sprintf("Dequeued client %s:%d by worker %d.\n", $sock->peerhost, $sock->peerport, threads->tid())); my $buf = ""; while(<$sock>) { # CAUTION: there isn't any self protection against very long lines last if /^\r\n$/; $buf .= $_; goto BYE if length $buf > MAX_LEN_HEADERS_BUFFER; } if (my $request = HTTP::Request->parse($buf)) { INFO(sprintf("[%s] %s {%s}\n", $request->method, $request->uri, $sock->peerhost)); } printf $sock "HTTP/1.1 %d %s\r\n", HTTP_MOVED_PERMANENTLY, status_message(HTTP_MOVED_PERMANENTLY); printf $sock "Date: %s\r\n", DateTime::Format::HTTP->format_datetime; print $sock "Location: $redir_uri\r\n"; print $sock "Server: Simple HTTP Redirection/0.1 ($^O)\r\n"; print $sock "Connection: close\r\n"; print $sock "\r\n"; BYE: $clients_served++; close($sock); } }
(*) just an approach, may drop connections:
while [ 1 ]; do echo -e "HTTP/1.1 301 Moved Permanently\r\nLocation: http://31337.pl\r\n\r\n" | nc -l 7070; done
