#!/usr/bin/env perl
# cassh - Manager for an OpenSSH Certification Authority
#
# Written in 2022 by Lucas
#
# To the extent possible under law, the author(s) have dedicated all
# copyright and related and neighboring rights to this software to the
# public domain worldwide. This software is distributed without any
# warranty.
# You should have received a copy of the CC0 Public Domain Dedication
# along with this software. If not, see
# <http://creativecommons.org/publicdomain/zero/1.0/>.

use v5.14;
use strict;
use warnings;

package SerialFile v1.0.0;

use overload '0+' => \&value;

sub new ($$)
{
	my $class = shift;
	my $self = {};
	bless $self, $class;
	return $self->_init(@_);
}

sub _init ($$)
{
	my ($self, $file) = @_;

	my $mode = -f $file ? "+<" : ">";
	open(my $fh, $mode, $file) or die "can't open $file: $!";
	my @lines = <$fh>;

	my $counter;
	if (@lines == 0) {
		$counter = 0;
	} elsif (@lines == 1 && $lines[0] =~ /^(\d+)$/) {
		$counter = $1;
	} else {
		return undef;
	}

	$self->{_fh} = $fh;
	$self->{_counter} = $counter;

	return $self;
}

sub inc ($;$)
{
	use integer;
	my ($self, $inc) = @_;
	$self->{_counter} += $inc // 1;
	return $self;
}

sub value ($)
{
	my $self = shift;
	return $self->{_counter};
}

sub commit ($)
{
	my $self = shift;

	truncate($self->{_fh}, 0) or return 0;
	seek($self->{_fh}, 0, 0) or return 0;

	return say {$self->{_fh}} $self->value();
}

sub DESTROY ($)
{
	local ($., $@, $!, $^E, $?);
	my $self = shift;
	close($self->{_fh});
}

package FormatToken v1.0.0;

use List::Util qw(all);

sub new ($)
{
	return bless {_tokens => {"%" => "%"}}, shift;
}

sub register ($;%)
{
	my ($self, %pairs) = @_;
	for (keys %pairs) {
		die "can't register $_" if !/^[A-Za-z]$/;
		$self->{_tokens}->{$_} = $pairs{$_};
	}
	return $self;
}

sub deregister ($;%)
{
	my ($self, %pairs) = @_;
	delete $self->{_tokens}->{$_} for (keys %pairs);
	return $self;
}

sub format ($$)
{
	my ($self, $in) = @_;
	die "can't format \"$in\"" unless
	    all {defined $self->{_tokens}->{$_}} ($in =~ /%([A-Za-z%])/g);
	return $in =~ s/%([A-Za-z%])/$self->{_tokens}->{$1}/egr;
}

package main;

use Getopt::Long qw(:config posix_default bundling no_ignore_case);

my $PATH_CA_PUB      = "./ca.pub";
my $PATH_CA_SERIAL   = "./serial.txt";
my $PATH_PUBKEYS_DIR = "./pubkeys";

my %COMMANDS = (
	issue  => \&main_issue,
	mkfile => \&main_mkfile,
);

my $PROGNAME = ($0 =~ s,.*/,,r);

sub usage ()
{
	print STDERR <<EOF;
Usage:
	$PROGNAME issue [-hqv] [-I key_id] [-n principals]
	    [-V validity_interval]
	$PROGNAME mkfile authorized_keys [options ...]
	$PROGNAME mkfile known_hosts [hostnames ...]
EOF
	exit 1;
}

sub err (@)
{
	say STDERR "$PROGNAME: @_";
	exit 1;
}

sub slurp ($)
{
	my $f = shift;

	open(my $fh, "<", $f) or err "can't open $f";
	local $/;
	my $s = <$fh>;
	close($fh);

	return $s;
}

# Returns comment from the ssh-agent if any is returned, otherwise it
# returns the public key's fingerprint.
sub get_ca_sk_comment_from_pk ($)
{
	my $f = shift;

	my ($fh, @ssh_keygen_lines, @ssh_add_lines);

	open($fh, "-|", "ssh-keygen", "-l", "-f", $f) or err "can't fork: $!";
	@ssh_keygen_lines = <$fh>;
	close($fh);

	open($fh, "-|", "ssh-add", "-l") or err "can't fork: $!";
	@ssh_add_lines = <$fh>;
	close($fh);

	my $comment;
	OUTER: foreach my $ssh_keygen_line (@ssh_keygen_lines) {
		chomp($ssh_keygen_line);
		my @ssh_keygen_parts = split(/ /, $ssh_keygen_line, 3);
		foreach my $ssh_add_line (@ssh_add_lines) {
			chomp($ssh_add_line);
			my @ssh_add_parts = split(/ /, $ssh_add_line, 3);
			if ($ssh_keygen_parts[1] eq $ssh_add_parts[1]) {
				my $s = $ssh_add_parts[2];
				$comment = substr($s, 0, rindex($s, " "));
				last OUTER;
			}
		}
	}

	return $comment;
}

sub get_pubkeys_files ($)
{
	my $d = shift;

	opendir(my $dh, "$d") or err "can't open directory $d";
	my @files = map {"$d/$_"}
	    grep {-f "$d/$_" && /\.pub$/ && !/-cert\.pub/} readdir($dh);
	closedir($dh);

	return @files;
}


sub main_issue ()
{
	my ($host, $key_id_fmt, $principals_fmt, $quiet, $verbose,
	    $validity_interval);

	$validity_interval = "always:forever";
	$key_id_fmt = "%C/%f";
	$verbose = 0;
	GetOptions(
		"h"   => \$host,
		"I=s" => \$key_id_fmt,
		"n=s" => \$principals_fmt,
		"q"   => \$quiet,
		"v+"  => \$verbose,
		"V=s" => \$validity_interval,
	) or usage;

	usage if @ARGV != 0;

	my ($hflag, $qflag, $vflag);
	$hflag = "-h" if defined($host);
	$qflag = "-q" if defined($quiet);
	$vflag = "-" . ("v" x $verbose) if $verbose > 0;

	my @files = get_pubkeys_files($PATH_PUBKEYS_DIR);
	exit 0 if @files == 0;

	my $formatter = FormatToken->new();
	my $ca_sk_comment = get_ca_sk_comment_from_pk($PATH_CA_PUB) // "cassh";
	$formatter->register(C => $ca_sk_comment);

	my $serial = SerialFile->new($PATH_CA_SERIAL);

	# Doing individual calls to ssh-keygen allows for using the filename as
	# a token in principals and key_id format.
	foreach my $file (@files) {
		$formatter->register(f => $file =~ s,.*/(.*)\.pub$,$1,r);

		my ($key_id, $principals);
		$key_id = $formatter->format($key_id_fmt);
		$principals = $formatter->format($principals_fmt) if
		    defined($principals_fmt);

		my @cmdopts = ("-I", $key_id, "-U", "-s", $PATH_CA_PUB,
		    "-V", $validity_interval, "-z", $serial);
		push(@cmdopts, "-h") if defined($host);
		push(@cmdopts, $qflag) if defined($qflag);
		push(@cmdopts, $vflag) if defined($vflag);
		push(@cmdopts, "-n", $principals) if defined($principals);

		system("ssh-keygen", @cmdopts, $file);
		if ($? == -1) {
			err "ssh-keygen: $!";
		} elsif ($? != 0) {
			exit $? >> 8;
		}

		$serial->inc()->commit() or err "can't save serial";
	}
}

sub main_mkfile ()
{
	usage if @ARGV < 1;
	my $file = shift @ARGV;

	err "no $PATH_CA_PUB found" if ! -f $PATH_CA_PUB;

	if ($file eq "authorized_keys") {
		print join(" ", join(",", "cert-authority", @ARGV),
		    slurp($PATH_CA_PUB));
	} elsif ($file eq "known_hosts") {
		print join(" ", grep {$_ ne ""} ('@cert-authority',
		    join(",", @ARGV), slurp($PATH_CA_PUB)));
	} else {
		err "unknown file $file";
	}
}

sub main ()
{
	usage if @ARGV < 1;

	my $cmd = shift @ARGV;

	usage if !defined($COMMANDS{$cmd});
	$COMMANDS{$cmd}->();
}

main();