#! /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::Select;
use IO::Socket::IP;

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

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

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;
while (<$fh>) { push(@listento, $_) unless /^#/ };
close($fh) || die "can't close $conffile: $!";

for my $i (0..$#listento) {
    if ( $listento[$i] =~ /^([\d.]+)$/ || $listento[$i] =~ /^([\da-fA-F:]+)$/ ) {
        $listento[$i] = $1;                # $listento now untainted
    }
    else {
        die "Bad listen to address: '$listento[$i]'";
    }
}

# Setup and create sockets
my $socks = IO::Select->new();
my %sockAutoProxy;
for my $i (0..$#listento) {
    my $autoProxy;
    my $sock;
    my $addr = $listento[$i];
    if ( $addr =~ /^[\d\.]+/ ) { # IPv4 address
        $autoProxy = "function FindProxyForURL(url, host) {".
                qq| return "PROXY $addr:3128; DIRECT"; }$crlf|;
        $sock = IO::Socket::IP->new(
            Domain       => PF_INET,
            LocalAddr    => $addr,
            LocalService => 'http',
            Proto        => 'tcp',
            Listen       => 30,
            Reuse        => 1
        );
    } elsif ( $addr =~ /^[\da-fA-F\:]+/ ) { # IPv6 address
        $autoProxy = "function FindProxyForURL(url, host) {".
                qq| return "PROXY [$addr]:3128; DIRECT"; }$crlf|;
        $sock = IO::Socket::IP->new(
            Domain       => PF_INET6,
            LocalAddr    => $addr,
            LocalService => 'http',
            Proto        => 'tcp',
            Listen       => 30,
            Reuse        => 1
        );
    }

    if ( !defined($sock) ) {
        print "error : cannot bind : $! exit\n";
        exit(1);
    }
    $socks->add($sock);
    $sockAutoProxy{$sock} = $autoProxy;
}

# 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 (my @ready = $socks->can_read()) {
    foreach my $sock (@ready) {
        my $new_sock = $sock->accept() or next;
        my $autoProxy = $sockAutoProxy{$sock} or die("unknown socket");
        # 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" .
                "Connection: close$crlf" .
                "Content-Type: application/octet-stream$crlf$crlf" .
                $autoProxy;
        } else {
            #------- Serve pixel file ----------------------
            print $new_sock "HTTP/1.0 200 OK$crlf" .
                "Server: $dbabId$crlf" .
                "Connection: close$crlf" .
                "Cache-Control: public, max-age=31536000$crlf" .
                "Content-type: image/gif$crlf" .
                "Content-length: 43$crlf$crlf" .
                $pixel;
        }

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

for my $handle ($socks->handles()) {
    $socks->remove($handle);
    close($handle);
}
exit(0);
