diff --git a/cassh.pl b/cassh.pl
new file mode 100644
index 0000000..e5b558e
--- /dev/null
+++ b/cassh.pl
@@ -0,0 +1,299 @@
+#!/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
+# .
+
+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 <;
+ 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();