#!/bin/sh -- # A comment mentioning perl
eval 'PATH=/dist/perl/bin:$PATH; export PATH; exec perl -S $0 ${1+"$@"}'
        if 0;

use Net::SSLeay qw(get_https post_https sslcat make_headers make_form);
use Time::Local;

chop($Program = `basename $0`);

$Cookie0 = '';

$Insert_Host = 1;

$Post = 0;
$PostAll = 0;
$Port = 443;


if ( $ENV{SSLCAT_SLOW} ne '' ) {
	$Net::SSLeay::slowly = $ENV{SSLCAT_SLOW};
}

if ( $ENV{SSLCAT_TRACE} ne '' ) {
	$Net::SSLeay::trace = $ENV{SSLCAT_TRACE};
} else {
	$Net::SSLeay::trace = 3;
	#$Net::SSLeay::trace = 0;
}

$Debug = 1;
$Spit_Cookies = 0;

$Usage = <<"END";

$Program: cat SSL webpages.

Usage: $Program [<options>] <url>

Options:
	-P <port>		Use <port> instead of $Port

	-p			Use POST method for first fetch.
	-pall			Use POST method for all fetches.

	-http			Do normal http connection.

	-nh			Do not insert Host: line.

	-c <cookie>		Insert <cookie> in Headers.
	-H <header:value>	Insert header (additive).

Notes:

END

LOOP:	
while (@ARGV) {
    $_ = shift;
    my($t, $k, $v);
    CASE: {
	/^-d$/ && ($Debug = 1, last CASE);
	/^-p$/ && ($Post = 1, last CASE);
	/^-pall$/ && ($Post = 1, $PostAll = 1, last CASE);
	/^-P$/ && ($Port = shift, last CASE);
	/^-spitcookies$/ && ($Spit_Cookies = 1, last CASE);
	/^-c$/ && ($Cookie0 = shift, last CASE);
	/^-nh$/ && ($Insert_Host = 0, last CASE);
	/^-H$/ && ($t = shift, my($k, $v) = split(/:/, $t, 2), $Send_Hdrs{$k} = $v, last CASE);
	/^--$/ && (last LOOP);	# -- means end of switches
	/^-(-.*)$/ && (unshift(@ARGV, $1), last CASE);
	/^(-h|-help)$/ && ((print STDERR $Usage), exit 0, last CASE);
	if ( /^-(..+)$/ ) {	# split bundled switches:
		local($y, $x) = ($1, '');
		foreach $x (reverse(split(//, $y))) { unshift(@ARGV,"-$x") };
		last CASE;
	}
	/^-/ && ((print STDERR "Invalid arg: $_\n$Usage"), exit 1, last CASE);
	unshift(@ARGV,$_);
	last LOOP;
    }
}

select(STDERR); $| = 1;
select(STDOUT); $| = 1;

if ( $Spit_Cookies ) {
	spit_cookies();
	exit;
}
cookie_init();

$rc = 0;
foreach $url (@ARGV) {
	# not clear how to handle multiple url's correctly
	# (wrt stdout and stderr and Cookies)
	$rc += &goget($url);
}

exit $rc;

############################################################################
sub goget {
	my($url0) = @_;

	print STDERR "========== $url0 ==========\n";

	my ($url, $proto, $host, $port, $path, $result);

	my %send_hdrs = %Send_Hdrs;

	$url = $url0;

	my $failure = 1;
	my $cnt = 1;
	my $first = 1;

	while (1) {

		$host = $url; 

		$proto = "https";
		$proto = $1 if $host =~ s,^(\w+)://,,;

		$path = "/";
		$path = $1 if $host =~ s,(/.*)$,,;
		#/
		
		$port = $Port;
		$port = $1 if $host =~ s,:(\d+)$,,;

		if ($Insert_Host) {
			$send_hdrs{'Host'} = $host;	# TODO :$port at end?
		}

		if ( $Cookie0 ne '' ) {
			store_cookie($Cookie0, $host, "/");	
		}

		delete $send_hdrs{'Cookie'};
		my $c = form_cookie($host, $path);
		$send_hdrs{'Cookie'} = $c if $c !~ /^\s*$/;
		
		print STDERR "get= cnt=$cnt\n";
		print STDERR "     host=$host\n";
		print STDERR "     proto=$proto\n";
		print STDERR "     port=$port\n";
		print STDERR "     path=$path\n";
		print STDERR "     hdrs=\n";
		print STDERR "\t", hjoin("\n\t", %send_hdrs), "\n";
		print STDERR "\n";

		my($page, $response, %headers);
		if ( $Post && $first ) {
			$first = 0 unless $PostAll;

			my ($query, %query);
			($path, $query) = split(/\?/, $path, 2);
			foreach my $piece (split(/&/, $query)) {
				my ($key, $val) = split(/=/, $piece, 2);
				$query{$key} = $val;
			}
			
			print STDERR "     post_path=$path\n";
			print STDERR "     post_query=$query\n";
			($page, $response, %headers) 
				= post_https($host, $port, $path,
						make_headers(%send_hdrs),
						make_form(%query)
					   );
		} else {
			($page, $response, %headers) 
				= get_https($host, $port, $path,
						make_headers(%send_hdrs)
					   );
		}

		print STDERR "resp=$response\n";
		print STDERR "hdrs=\n\t", hjoin("\n\t", %headers), "\n";

		my ($vers, $code, $msg) = split(' ', $response, 3);

		if ( $code =~ /^2\d\d$/ ) {
			print STDERR "page=\n";
			print STDOUT $page;
		} else {
			print STDERR "errpage=\n";
			print STDERR $page;
		}

		%send_hdrs = %Send_Hdrs;

		$cnt++;
		if ( $cnt > 16 ) {
			# too many
			last;
		} elsif ( $code =~ /^2\d\d$/ ) {
			# wow, got it. or got something. 
			$failure = 0;
			last;
		} elsif ( $code =~ /^3\d\d$/ ) {
			# evidently need to follow...
			my $loc = '';
			if ( $headers{Location} ) {
				$loc = $headers{Location};
			} elsif ( $headers{LOCATION} ) {
				$loc = $headers{LOCATION};
			}
			last if $loc eq ''; 
			$url = $loc;
			if ( $url !~ m,^\w+://, ) {
				if ( $url =~ m,^/, ) {
					$url = "${proto}://$host/$url";
				} else {
					my $tmp = $path;
					$tmp =~ s/\?.*$//;
					$tmp =~ s,/[^/]+$,/,;
					$tmp = "/$tmp" unless $tmp =~ m,^/,;
					$tmp =~ s,^/+,/,;
					$tmp =~ s,/+$,/,;
					$url = "${proto}://${host}${tmp}${url}";
				}
			}
			if ( $headers{'Set-Cookie'} ) {
				store_cookie($headers{'Set-Cookie'}, $host, $path);
			} elsif ( $headers{'SET-COOKIE'} ) {
				store_cookie($headers{'SET-COOKIE'}, $host, $path);
			}
		} elsif ( $code =~ /^4\d\d$/ ) {
			print STDERR "400 error\n";
			last;
		} elsif ( $code =~ /^5\d\d$/ ) {
			print STDERR "500 error\n";
			last;
		} else {
			print STDERR "really unknown error\n";
			last;
		}
	}
	return $failure;
}

sub hjoin {
	my ($sep, %hash) = @_;
	my @tmp;
	my ($key, $val);
	while ( ($key, $val) = each(%hash) ) {
		push(@tmp, "$key: $val");
	}
	return join($sep, @tmp);
}

sub spit_cookies {
	open(FILE, "<$0") || die "$!";

	print STDOUT <<"END";
use Time::Local; 
cookie_init();
END
	my $on = 0;
	while (<FILE>) {
		if ( ! $on && /^#CookieUtils/ ) {
			$on = 1;
			next;
		}
		if ( $on && /^__END__/ ) {
			$on = 0;
			next;
		}
		print STDOUT $_ if $on;
	}
	close(FILE);
}

#CookieUtils

sub cookie_init {
	
	$Send_Hdrs{'User-Agent'} = 'Mozilla/4.76 [en] (X11; U; Linux 2.2.19 i686)';
	$Send_Hdrs{'Connection'} = 'close';
	$Send_Hdrs{'Accept'} = 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*';
	$Send_Hdrs{'Accept-Language'} = 'en';
	$Send_Hdrs{'Accept-Charset'} = 'iso-8859-1,*,utf-8';

	$Future = 2147000000;	# Jan 2038	
}

sub store_cookie {
	my ($cookie, $host, $urlpath) = @_;

	$cookie =~ s/^\s*//;
	$cookie =~ s/\s*$//;

	my $name = '';
	my $nameval = '';
	my $expires = '';
	my $path = '';
	my $domain = '';
	my $secure = 0;

	# handle the general case of multiple cookies in the string $cookie.
	foreach my $item (split(/\s*;\s*/, $cookie)) {
		if ( $item =~ /^expires=/i ) {
			$expires = $';
		} elsif ( $item =~ /^path=/i ) {
			$path = $';
		} elsif ( $item =~ /^domain=/i ) {
			$domain = $';
		} elsif ( $item =~ /^secure/i ) {
			$secure = 1;
		} elsif ( $item =~ /^([^=]+)=/ ) {
			my $n = $1;
			if ( $name ne '' ) {
				$path = $urlpath unless $path ne '';
				$domain = $host unless $domain ne '';
				$expires = $Future unless $expires ne '';

				$Cookies{$name}{$path}{expires} = $expires;
				$Cookies{$name}{$path}{timeout}
							= expire_time($expires);
				$Cookies{$name}{$path}{secure}  = $secure;
				$Cookies{$name}{$path}{domain}  = $domain;
				$Cookies{$name}{$path}{cookie}  = $nameval;
			}
			# setup for next one:
			$name = $n;
			$nameval = $item;
			$expires = '';
			$path = '';
			$domain = '';
			$secure = 0;
			
		} else {
			print STDERR "store_cookie: bad cookie item: '$item' cookie='$cookie'\n";
			next;
		}
	}
	if ( $name ne '' ) {
		$path = $urlpath unless $path ne '';
		$domain = $host  unless $domain ne '';
		$expires = $Future unless $expires ne '';

		$Cookies{$name}{$path}{expires} = $expires;
		$Cookies{$name}{$path}{timeout} = expire_time($expires);
		$Cookies{$name}{$path}{secure}  = $secure;
		$Cookies{$name}{$path}{domain}  = $domain;
		$Cookies{$name}{$path}{cookie}  = $nameval;
	}
}

sub form_cookie {
	my ($host, $urlpath) = @_;
	print STDERR "form_cookie: $host -- $urlpath\n" if $Debug;

	my $time = time;
	my ($nameval, $path, $domain);
	my (%cookies);

	foreach $name (keys(%Cookies)) {
		print STDERR "form_cookie: $name\n" if $Debug;
		foreach $path (keys (%{$Cookies{$name}}) ) {
			print STDERR "form_cookie: $name -- $path\n" if $Debug;
			next unless $urlpath =~ /^\Q$path\E/;
			print STDERR "form_cookie: MATCHED_PATH: $path\n" if $Debug;
			print STDERR "form_cookie: times: $time -- $Cookies{$name}{$path}{timeout}\n" if $Debug;
			next unless $time < $Cookies{$name}{$path}{timeout};
			print STDERR "form_cookie: time OK: $time\n" if $Debug;
			$domain = $Cookies{$name}{$path}{domain};
			print STDERR "form_cookie: domain: $domain\n" if $Debug;
			next unless $host =~ /\Q$domain\E$/;
			print STDERR "form_cookie: MATCHED_DOMAIN: $host\n" if $Debug;

			$nameval = $Cookies{$name}{$path}{cookie};
			print STDERR "form_cookie: NAMEVAL: $nameval\n" if $Debug;
		
			$cookies{$nameval} = length($path);
		}
	}

	my @list = sort { $cookies{$b} <=> $cookies{$a} } keys(%cookies);

	return join("; ", @list);
}

sub expire_time {
	my($date) = @_;

	print STDERR "expire_time: $date\n" if $Debug;

	if ( $date =~ /^\d+$/ ) {
		return $date;
	}
	if ( ! %Months ) {
		$Months{'jan'} = 0;
		$Months{'feb'} = 1;
		$Months{'mar'} = 2;
		$Months{'apr'} = 3;
		$Months{'may'} = 4;
		$Months{'jun'} = 5;
		$Months{'jul'} = 6;
		$Months{'aug'} = 7;
		$Months{'sep'} = 8;
		$Months{'oct'} = 9;
		$Months{'nov'} = 10;
		$Months{'dec'} = 11;
	}

	my ($wdy, $dd_mon_yyyy, $hh_mm_ss, $gmt) = split(' ', $date, 4);

	my ($mday, $mon, $year) = split(/-/, $dd_mon_yyyy);
	my ($hour, $min, $sec) = split(/:/, $hh_mm_ss);

	if ( $year =~ /^\d\d$/ ) {
		if ( $year > 68 ) {
			$year = "19$year";
		} else {
			$year = "20$year";
		}
	}

	$mon =~ y/A-Z/a-z/;

	if ( $Months{$mon} ) {
		$mon = $Months{$mon};
	} else {
		$mon = 'dec';	# punt...
	}

	my $time = timegm($sec,$min,$hour,$mday,$mon,$year);
	print STDERR "expire time: $time  --  $date\n" if $Debug;

	if ( $time !~ /^\d+$/ ) {
		$time = $Future;
	}

	return $time;
}

__END__

  use Net::SSLeay, qw(get_https post_https sslcat make_headers make_form);

  ($page) = get_https('www.cryptsoft.com', 443, '/');                 # 1

  ($page, $response, %reply_headers)
         = get_https('www.cryptsoft.com', 443, '/',                   # 2
                make_headers(
                        'User-Agent' => 'Cryptozilla/5.0b1',
                        'Referer'    => 'https://brutus.neuronio.pt'
                ));

  ($page, $response, %reply_headers)
         = post_https('www.cryptsoft.com', 443, '/foo.cgi', '',       # 3
                make_form(
                        'OK'   => '1',
                        'name' => 'Sampo'
                ));

  $reply = sslcat($host, $port, $request);                            # 4

  $Net::SSLeay::trace = 0;  # 0=no debugging, 1=ciphers, 2=trace, 3=dump data