#!/usr/bin/env perl
use strict;
use warnings;

use LWP::UserAgent;
use HTTP::Request::Common;
use Getopt::Long;
use Net::Hesiod;

$ENV{HTTPS_CA_DIR} = "/etc/ssl/certs";

$ENV{HTTPS_CERT_FILE} = "$ENV{HOME}/mit/certs/cert.pem";
$ENV{HTTPS_KEY_FILE} = "$ENV{HOME}/mit/certs/privkey.pem";

# $ENV{HTTPS_PKCS12_FILE} = "/home/nelhage/mit/cert.p12";
# $ENV{HTTPS_PKCS12_PASSWORD} = "password";

# A note on certificates:

#		This script obviously needs access to your certificates to
#		work. The easiest way to get them is probably by exporting from
#		Firefox. Go to Edit|Preferences, Advanced|Security|View
#		Certificates, and ``Backup'' your certificate to a file. Firefox
#		will save it as a PKCS12 certificate. You can either give the
#		script the path to that and a password for it above (or by
#		setting appropriate environment variables, or reading the
#		password from the command-line), or you can convert them into
#		PEM format, as a separate certificate and private key using
#		openssl. This has the feature (either good or bad, depending on
#		your paranoia and laziness level) of optionally not needing a
#		password; Also, things like wget can also grok PEM. You can do
#		so with the following two commands:
#
#		openssl pkcs12 -in /path/to/cert.p12 -nodes -out cert.pem
#		openssl pkcs12 -in /path/to/cert.p12 -nodes -nocerts -out privkey.pem

if($ENV{HTTPS_PKCS12_FILE} && !$ENV{HTTPS_PKCS12_PASSWORD}) {
    print "Enter password for " . $ENV{HTTPS_PKCS12_FILE} . ": ";
    use Term::ReadKey;
    ReadMode('noecho');
    $ENV{HTTP_PKCS12_PASSWORD} = <STDIN>;
    chomp $ENV{HTTP_PKCS12_PASSWORD};
    ReadMode('restore');
}


use constant FORM_URL => "https://wserv.mit.edu:444/fcgi-bin/lc";
my $firstFormConstantParms = [
	data => 1,
	page => "index",
	mailman => 0,
	nfsgroup => 0,
	mail => 1,
	];

my $secondFormConstantParms = [
	page => "confirm",
	submit => "Yes",
   ];

my $verbose = 0;

use constant UID_PARM			 => "uid";
use constant LIST_NAME_PARM		 => "tlist";
use constant PUBLIC_PARM		 => "public";
use constant HIDDEN_PARM		 => "hidden";
use constant AFS_GROUP_PARM		 => "group";
use constant OWNER_TYPE_PARM    	 => "ownertype";
use constant OWNER_TYPE_USER             => 1;
use constant OWNER_TYPE_GROUP   	 => 2;
use constant OWNER_PARM			 => "owner";
use constant DESCRIPTION_PARM            => "description";

my $ctx = Net::Hesiod->new();

my ($name, $public, $hidden, $group, $owner, $ownerType, $description, $help);
$public = 0;
$hidden = 0;
$group = 0;
$owner = "";
$description = "";
$help = 0;

GetOptions(
    "-v"              => \$verbose,
    "--verbose"       => \$verbose,
    "-P"              => \$public,
    "--public"        => \$public,
    "-H"              => \$hidden,
    "--hidden"        => \$hidden,
    "-G"              => \$group,
    "--group"         => \$group,
    "-O=s"            => \$owner,
    "--owner=s"       => \$owner,
    "-D=s"            => \$description,
    "--description=s" => \$description,
    "--help"          => \$help
) or usage();

usage() if $help;
$name = shift || usage();

my $userAgent = LWP::UserAgent->new();
my $parms;
my $uid;
my $response;

$ownerType = resolveOwnerType($owner);

debug("List owner is a " . (($ownerType == OWNER_TYPE_USER) ? "user" : "group"));

$uid = scrapeUid();

debug("Scraped initial form UID: " . $uid);

$parms = getFirstFormParms();

debugParms("First form", $parms);

$response = $userAgent->request(POST FORM_URL, $parms);

die("Error sending form: " . $response->status_line) unless ($response->is_success);

$uid = getSecondFormUid($response->content);

$parms = getSecondFormParms();

debugParms("Second form", $parms);

$response = $userAgent->request(POST FORM_URL, $parms);

die("Error sending form: " . $response->status_line) unless ($response->is_success);

print "List should be created ... blancheing to check:\n";

exec("blanche $name -i");


sub usage {
	print <<EOF;
Usage: create-list [options] list-name
Options:
        -v, --verbose           Verbose
        -P, --public            Public (default private)
        -H, --hidden            Hidden (default visible)
        -G, --group             AFS Group (default not)
        -O, --owner...          Set group owner (default certificate owner)
        -D, --description=...   Set list description
        -h, --help              This help.
EOF
	exit(0);
}

sub resolveOwnerType {
	my $owner = shift;
	return OWNER_TYPE_USER unless length $owner;
	my @user = $ctx->hesiod_resolve($owner, "passwd");
	my @group = $ctx->hesiod_resolve($owner, "group");
	if (scalar(@user)) {
		debug("Resolved user $owner as " . $user[0]);
	}
	if (scalar(@group)) {
		debug("Resolved group $owner as " . $group[0]);
	}
	
	scalar @user and return OWNER_TYPE_USER;
	scalar @group and return OWNER_TYPE_GROUP;

	die("$owner not found as a group or user");
}

sub scrapeUid {
	my $response = $userAgent->get(FORM_URL);
	die($response->status_line) unless ($response->is_success);
	my $uid = $1 if $response->content =~ /name=uid value="([\d]+-[\d]+)"/;
	$uid or die("Unable to scrape UID!");
	return $uid;
}

sub getFirstFormParms {
	my $parms = $firstFormConstantParms;
	push @$parms, (UID_PARM, $uid);
	push @$parms, (LIST_NAME_PARM, $name);
	push @$parms, (PUBLIC_PARM, $public?"1":"0");
	push @$parms, (HIDDEN_PARM, $hidden?"1":"0");
	push @$parms, (AFS_GROUP_PARM, $group?"1":"0");
	push @$parms, (OWNER_TYPE_PARM, $ownerType);
	push @$parms, (OWNER_PARM, $owner);
	push @$parms, (DESCRIPTION_PARM, $description);

	return $parms;
}

sub getSecondFormUid {
	my $content = shift;
	my $uid;
	$uid = $1 if $content =~ /name=uid value=([\d]+-[\d]+)/;
	return $uid if $uid;

	if ($content =~ /<td bgcolor="#FFCCCC">\s+<b>(.*)<\/b>/) {
		print STDERR "Error: $1\n";
		exit 1;
	}
	die("Unable to scrape a second form UID");
}

sub getSecondFormParms {
	my $parms = $secondFormConstantParms;
	push @$parms, (UID_PARM, $uid);

	return $parms;
}

sub debug {
	my $msg = shift;
	if ($verbose) {
		print "$msg\n";
	}
}

sub debugParms {
	return unless $verbose;
	my $name = shift;
	my $parms = shift;
	my %parms = @$parms;
	print "Parameter for $name:\n";
	for my $key (keys %parms) {
		print "\t$key => " . $parms{$key}, "\n";
	}
}