#! /usr/bin/perl -Tw

##-----------------------------------------------------------------------
## Porgram: dbab-svr pixelserv
## Purpose: super minimal webserver serving a 1x1 pixel transparent gif
## Authors: Tong Sun (c) 2013-2020
## Authors: Originally wrote by Piet Wintjens, date unknown
## License: covered by the new BSD (no advertising clause) license
## Reference: Well House Consultants training course
##	    http://www.wellho.net/resources/ex.php4?item=p402/miniserver.pl
##-----------------------------------------------------------------------

use strict;
use warnings;

use IO::Socket::INET;

my $dbabId = "dbab/v1.5";

my $conffile = "/etc/dbab/dbab.addr";
my $proxyfile = $conffile;

my $crlf  = Socket::CRLF;
my $pixel = pack( "C*",
    qw(71 73 70 56 57 97 1 0 1 0 128 0 0 255 255 255 0 0 0 33 249 4 1 0 0 0 0 44 0 0 0 0 1 0 1 0 0 2 2 68 1 0 59)
);

my $fh;

#-------- conf file ---------------
open($fh, "<", $conffile) || die "can't open $conffile: $!";
my $listento = do { local $/; <$fh> };
close($fh) || die "can't close $conffile: $!";

if ( $listento =~ /^([\d.]+)$/ ) {
    $listento = $1;                # $listento now untainted
}
else {
    die "Bad listen to address: '$listento'";
}

#-------- proxy file ---------------
open($fh, "<", $proxyfile) || die "can't open $proxyfile: $!";
my $proxyaddr = do { local $/; <$fh> };
close($fh) || die "can't close $proxyfile: $!";

if ( $proxyaddr =~ /^([\w.]+)$/ ) {
    $proxyaddr = $1;                # $proxyaddr now untainted
}
else {
    die "Error opening proxy definition file: '$proxyaddr'";
}
my $autoProxy = "function FindProxyForURL(url, host) {".
            qq| return "PROXY $proxyaddr:3128; DIRECT"; }$crlf|;

# Setup and create socket
my $sock = IO::Socket::INET->new(
    LocalHost => $listento,
    LocalPort => '80',
    Proto     => 'tcp',
    Listen    => 30,
    Reuse     => 1
);

if ( !defined($sock) ) {
    print "error : cannot bind : $! exit\n";
    exit(1);
}

# If the connection is open, but get closed before dbab-svr has
# sent the pixel, the SIGPIPE gets send, and dbab-srv will die.
# Ignore such signal as we can write to a closed connection anyway. 
local $SIG{'PIPE'} = 'IGNORE';

# Await requests and handle them as they arrive
while (1) {
    my  $new_sock = $sock->accept() or next;
    # set timeout of 2s to avoid blocking the whole program
    $new_sock->setsockopt(SOL_SOCKET, SO_RCVTIMEO, pack('l!l!', 2, 0));
    my %request = ();
    local $/ = $crlf;
    #-------- Read Request ---------------
    while (my $req = <$new_sock>) {
        chomp $req; # Main http request
        if ( $req =~ /^$/ ) { last; }
        if ( $req =~ /\s*(\w+)\s*([^\s]+)\s*HTTP\/(\d.\d)/ ) {
            $request{METHOD} = uc $1;
            $request{URL} = $2;
            $request{HTTP_VERSION} = $3;
            next;
        }
    }
    
    if (defined($request{METHOD}) and $request{METHOD} eq 'GET' and
    	    ($request{URL} eq '/proxy.pac' or
    	     $request{URL} eq '/wpad.dat') ) {
        #------- Serve pac/wpad file --------------------
        print $new_sock "HTTP/1.0 200 OK$crlf";
        print $new_sock "Connection: close$crlf";
        print $new_sock "Content-Type: application/octet-stream$crlf$crlf";
        print $new_sock $autoProxy;
    } else {
        #------- Serve pixel file ----------------------
        print $new_sock "HTTP/1.0 200 OK$crlf";
        print $new_sock "Server: $dbabId$crlf";
        print $new_sock "Connection: close$crlf";
        print $new_sock "Cache-Control: public, max-age=31536000$crlf";
        print $new_sock "Content-type: image/gif$crlf";
        print $new_sock "Content-length: 43$crlf$crlf";
        print $new_sock $pixel;
    }

    shutdown( $new_sock, 2 );
    undef($new_sock);
}

close($sock);
exit(0);
