Reimplement in Perl
This commit is contained in:
parent
be8e55bb06
commit
fe858efc53
299
cassh.pl
Normal file
299
cassh.pl
Normal file
@ -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
|
||||||
|
# <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();
|
||||||
Loading…
Reference in New Issue
Block a user