#! /usr/bin/env perl
# Copyright 2012, Matthias Andreas Benkard <code@mail.matthias.benkard.de>.

use common::sense;
use Modern::Perl;
use JSON;
use Crypt::OpenSSL::RSA;
use File::Slurp;
use File::Path qw(make_path);
use File::Copy;
use LWP::Simple qw(getstore);
use Data::Dumper;

sub prompt($$) {
  my ($question, $default) = @_;
  $|++;
  print "${question} \[${default}\] ";
  $_ = <>;
  chomp;
  if ($_) {
    return $_;
  } else {
    return $default;
  }
}

sub printspec($$) {
  my ($outfile, $key) = @_;
  my ($n, $e, @stuff) = $key->get_key_parameters;
  say $outfile
      encode_json({"public-key"     => {e => $e->to_decimal, n => $n->to_decimal, algorithm => "RS"},
                   "authentication" => "/browserid/authenticate.html",
                   "provisioning"   => "/browserid/provision.html"});
};

my $conffile = "www/config.pl";

# Generate configuration file.
$::MULKONF = { };
if (stat($conffile)) {
  say "Found existing configuration ($conffile).";
  do $conffile;
}

my $configpath = $::MULKONF->{configpath} // "/etc/mulkyid";
$configpath    = prompt("Where shall I put configuration files?", $configpath);
my $pemfile    = $::MULKONF->{pemfile}    // "$configpath/rsa2048.pem";
$pemfile       = prompt("Where shall I put the private key?", $pemfile);
my $aliases_file = $::MULKONF->{aliases_file} // "/etc/aliases";
$aliases_file  = prompt("Where is the aliases file?  Type a single dot for none.", $aliases_file);
my $imap_server = $::MULKONF->{imap_server} // "localhost";
$imap_server  = prompt("What is the IMAP server's address?", $imap_server);
my $imap_port = $::MULKONF->{imap_port} // 143;
$imap_port  = int(prompt("What is the IMAP server's port?", $imap_port));

say "OK.";

# Download jQuery.
make_path("www/jquery");
if (stat("www/jquery/jquery.js")) {
  say "Using existing copy of jQuery (www/jquery/jquery.js).";
} else {
  say "Fetching jQuery...";
  getstore("http://code.jquery.com/jquery-1.7.2.min.js", "www/jquery/jquery.js")
    or die "Could not fetch jQuery";
  say "jQuery saved to: www/jquery/jquery.js";
}

# Generate the private key.
my $key;
if (stat($pemfile)) {
  say "Using existing private key ($pemfile).";
  $key = Crypt::OpenSSL::RSA->new_private_key(scalar read_file($pemfile));
} else {
  say "Generating private key...";
  $key = Crypt::OpenSSL::RSA->generate_key(2048);
  make_path($configpath);
  open(my $keyfile, ">", $pemfile)
    or die "Cannot open $pemfile for writing: $!";
  print $keyfile $key->get_private_key_string();
  close $keyfile;
  say "Private key saved to: $pemfile".
  chmod 0440, $pemfile;
}

# Generate spec file.
open(my $specfile, ">", "browserid.json")
  or die "Cannot open browserid.json for writing: $!";
printspec $specfile, $key;
close($specfile);
say "Persona spec file saved to: browserid.json";

# Generate configuration file.
$::MULKONF = {
  configpath   => $configpath,
  pemfile      => $pemfile,
  aliases_file => $aliases_file,
  imap_server  => $imap_server,
  imap_port    => $imap_port
};
open(my $conffd, ">", $conffile)
  or die "Cannot open $conffile for writing: $!";
print $conffd <<EOF;
#! /usr/bin/env perl
# NB. Do not edit this file directly.  It is overwritten with each run of setup.pl.
@{[Data::Dumper->Dump([$::MULKONF], ["::MULKONF"])]}
1;
EOF
close $conffd;
say "Configuration saved to: $conffile";

say "";
say "******************************************************************";
say "* FINISHED.                                                      *";
say "*                                                                *";
say "* Please put browserid.json where it will be served as           *";
say "*     https://<whatever>/.well-known/browserid                   *";
say "* with a content type of:                                        *";
say "*     application/json                                           *";
say "*                                                                *";
say "* In addition, please ensure that the private key file can be    *";
say "* read by the web server by assigning the file to the            *";
say "* appropriate owner.                                             *";
say "******************************************************************";