~mclehman/guestctl

eb89ebffdd71f54bb7cdc1a0a73eedf19287f80a — 0xFORDCOMMA 5 years ago
Initial commit because I make questionable version-control choices.
A  => .gitignore +5 -0
@@ 1,5 @@
.#*
# Ignore demo videos.
*.mov
*.mp4
lib/.precomp

A  => META6.json +26 -0
@@ 1,26 @@
{
    "name" : "guestctl",
    "provides" : {
        "App::Guestctl::Common"    : "lib/App/Guestctl/Common.pm6",
        "App::Guestctl::Guests"    : "lib/App/Guestctl/Guests.pm6",
        "App::Guestctl::Templates" : "lib/App/Guestctl/Templates.pm6",
        "App::Guestctl::Utils"     : "lib/App/Guestctl/Utils.pm6"
    },
    "resources" : [
        "templates/dockerfile.tmpl",
        "templates/docker-compose.tmpl",
        "templates/sshd_config.tmpl"
    ],
    "version" : "0.0.1",
    "production" : false,
    "perl" : "v6.*",
    "authors" : [
        "Max"
    ],
    "license" : "https://opensource.org/licenses/Artistic-2.0",
    "scripts" : {
        "test" : "zef test ."
    },
    "source-url" : "False",
    "description" : ""
}

A  => bin/guestctl +140 -0
@@ 1,140 @@
#!/usr/bin/env perl6

use App::Guestctl::Common;
use App::Guestctl::Guests;
use App::Guestctl::Templates;
use App::Guestctl::Utils;

# Primary main subroutine for individual guest control.
multi MAIN($guest, GuestAction $action) {
    # Run remotely if properly configured to do so.
    given %*ENV<GUEST_REMOTE_HOST GUEST_REMOTE_EXE> {
        when *.all.defined {
            note "[" ~ $guest ~ '@' ~ $_ ~ "]";
            transparent-run <<ssh $_ @*ARGS[]>>;
        }
    }

    # Guest layout checks. Could be done with the typesystem, but simple error reporting would suffer.
    my $guests-dir = check-guests-dir() or note qq{Invalid guests prefix. Is GUEST_PREFIX set?} and exit 1;

    unless is-valid-guest($guest, $guests-dir) {
        note qq{Invalid guest "$guest".};
        exit 1;
    }

    my $guest-dir = get-guest-dir $guests-dir, $guest;
    my $command   = parse-guest-action $action;
    my $status    = get-guest-status $guest-dir;

    given ($command, $status) {
        when (Up, Stopped) {
            note qq{Bringing guest "$guest" online.};
            transparent-run <docker-compose up -d>, cwd => $guest-dir;
        }

        when (Down, Running) {
            # Persist changes to guest-$guest:live image
            note qq{Committing current configuration for guest "$guest".};
            my $live-image = "guest-" ~ $guest ~ ":live";
            my $container-id = run(<<docker-compose ps -q $guest>>, :out, cwd => $guest-dir).out.slurp.chomp;
            transparent-run <<docker commit $container-id $live-image>>, cwd => $guest-dir, :proceed;
            note qq{Taking guest "$guest" offline.};
            transparent-run <docker-compose down>, cwd => $guest-dir;
        }

        when (Restart, Running) {
            note qq{Restarting guest "$guest".};
            transparent-run <docker-compose restart>, cwd => $guest-dir;
        }

        default {
            # Show status, either because it was requested or because the requested action is invalid.
            # Since type-checking MAIN guarantees that a valid command was received, this does not have to be an unknown command catch-all.
            note qq{Guest "$guest" is currently $status.value().}
        }
    }
}

# Management MAIN subroutine (updating server-side script (scp for now, git later?), syncing guest configs)
multi MAIN("manage", ManageAction $action) {
    given parse-manage-action $action {
        when Sync {
            # TODO: mirror local guest config to remote guest host.
            note qq{Sorry, the "sync" functionality is not yet implemented. Guest configurations must be managed server-side.};
        }
        when Update {
            my $host = %*ENV<GUEST_REMOTE_HOST>              // die "No remote host set. Sync aborted.";
            my $remote-bin-dir = %*ENV<GUEST_REMOTE_BIN_DIR> // die "No remote binary directory set. Sync aborted.";
            my $dest-path = $host ~ ":" ~ $remote-bin-dir.IO.add: "/guest";
            note qq{Updating "guest" utility on host "$host".};
            transparent-run <<scp $*PROGRAM $dest-path>>;
        }
    }
}


# Creation of new guests according to set templates.
multi MAIN("new", $guest) {
    given %*ENV<GUEST_REMOTE_HOST GUEST_REMOTE_EXE> {
        when *.all.defined {
            note "[" ~ $guest ~ '@' ~ $_ ~ "]";
            transparent-run <<ssh $_ @*ARGS[]>>;
        }
    }

    my $guests-dir = %*ENV<GUEST_PREFIX> // die "GUEST_PREFIX not set.";
    unless $guests-dir.IO.d {
        note qq{Guests directory "$guests-dir" does not exist.};
        exit 1;
    }
    if is-valid-guest $guest, $guests-dir {
        note qq{Guest "$guest" already exists.};
        exit 1;
    }

    my $template-dir = $guests-dir.IO.add: ".skeleton";

    my $guest-dir = $guests-dir.IO.add: $guest;
    mkdir $guest-dir;
    my $ssh-dir = $guest-dir.add: "ssh";
    mkdir $ssh-dir;

    my @prompt-entries = {
                             key        => "user",
                             prompt     => "Guest username: "
                         },
                         {
                             key        => "password",
                             prompt     => "(populates dockerfile, change immediately on getting access)\nGuest password: "
                         },
                         {
                             key        => "hostname",
                             prompt     => "Guest hostname: "
                         },
                         {
                             key        => "ssh_port",
                             prompt     => "Guest SSH port [1024-65535]: ",
                             constraint => 1024 <= * <= 65535,
                         },
                         {
                             key        => "ssh_key",
                             prompt     => "Initial SSH public key: "
                         },
                         {
                             key        => "base",
                             prompt     => "Arch or Ubuntu? ",
                             constraint => rx:i/arch | ubuntu/,
                             normalize  => *.lc,
                         };

    my %variables = gen-template-vars @prompt-entries, $guest;
    my @template-files = load-template-files $template-dir;

    # Effectful: instantiate and write out template files in new guest directory.
    instantiate-template-files @template-files, %variables, $guest-dir;

    my ($guest-base-image, $guest-live-image) = "guest-$guest" <<~>> <:base :live>;
    transparent-run <<docker build -t $guest-base-image $guest-dir>>, :proceed;
    transparent-run <<docker tag $guest-base-image $guest-live-image>>;
}

A  => lib/App/Guestctl/Common.pm6 +32 -0
@@ 1,32 @@
unit module App::Guestctl::Common;

# Enum members are paired with their domain string representations.
# For GuestStatus, the string representations are used when status is output.
# For _____Command, the string representations are used to parse ______Action
# elements. These Action types are used to constrain command line arguments.
enum GuestStatus is export
    (Running => "up",
     Stopped => "down");

enum GuestCommand is export
    (Up      => "up",
     Down    => "down",
     Restart => "restart",
     Status  => "status");

enum ManageCommand is export
    (Update  => "update",
     Sync    => "sync",
     Create  => "create");

enum RegisterCommand is export
    (Remote  => "remote",
     Host    => "host");

# I do not like this structure, but don't have a better option.
# Adding export declarations seriously harms readability.
subset GuestAction is export
    of Str where * eq any  GuestCommand::.values>>.Str;

subset ManageAction is export
    of Str where * eq any ManageCommand::.values>>.Str;

A  => lib/App/Guestctl/Guests.pm6 +34 -0
@@ 1,34 @@
unit module App::Guestctl::Guests;

use App::Guestctl::Common;

sub check-guests-dir() is export {
    my $guests-dir = %*ENV<GUEST_PREFIX> // return False;
    if $guests-dir.IO.d {
        return $guests-dir;
    } else {
        return False;
    }
}

# Valid guests must have a directory either created out-of-band or through the
# management capabilities of guestctl. Insufficiently configured guests are not
# in scope here. Attempted docker/docker-compose actions will reveal any issue.
sub is-valid-guest($guest, $guests-dir) is export {
    return dir($guests-dir).first({ .basename ~~ $guest }).d;
}

sub get-guest-status($guest-dir) is export {
    given run(<docker-compose ps -q>, :out, cwd => $guest-dir).out.lines.elems {
        when 0 {
            return Stopped;
        }
        default {
            return Running;
        }
    }
}

sub get-guest-dir($guests-dir, $guest) is export {
    return $guests-dir.IO.add: $guest;
}

A  => lib/App/Guestctl/Templates.pm6 +48 -0
@@ 1,48 @@
unit module App::Guestctl::Templates;

use App::Guestctl::Utils;
use Template::Mustache;

our %builtin-templates =
    arch => {
        base_image => "base/archlinux",
        package_manager => "pacman",
        package_manager_update => "-Sy",
        package_manager_install => "-S",
        noconfirm => "--noconfirm",
        ssh_server => "openssh",
        aux_packages => "audit"
    },
    ubuntu => {
        base_image => "ubuntu",
        package_manager => "apt",
        package_manager_update => "update",
        package_manager_install => "install",
        noconfirm => "-y",
        ssh_server => "ssh",
        aux_dockerfile => "RUN mkdir -p /var/run/sshd"
    };

sub gen-template-vars(@prompt-entries, $guest) is export {
    my %responses = manage-prompt @prompt-entries;

    # Construct a template by merging a builtin template with the prompted
    # input as well as the new guest handle.
    my %template-vars = |%builtin-templates{%responses<base>},
                        |%responses,
                        :$guest;

    return %template-vars;
}

sub load-template-files($template-dir) is export {
    return ("Dockerfile"         => %?RESOURCES<templates/dockerfile.tmpl>.slurp,
            "docker-compose.yml" => %?RESOURCES<templates/docker-compose.tmpl>.slurp,
            "ssh/sshd_config"    => %?RESOURCES<templates/sshd_config.tmpl>.slurp);
}

sub instantiate-template-files(@template-files, %variables, $guest-dir) is export {
    for @template-files -> (:key($dest-file), :value($template)) {
        $guest-dir.add($dest-file).spurt: Template::Mustache.render($template, %variables);
    }
}

A  => lib/App/Guestctl/Utils.pm6 +46 -0
@@ 1,46 @@
unit module App::Guestctl::Utils;

use App::Guestctl::Common;

# Run another process and replay its output and exit code. Optionally, do not exit.
sub transparent-run(*@run-args, :$cwd = $*CWD, :$proceed = False) is export {
    my $proc = Proc::Async.new: |@run-args;
    react {
        whenever $proc.stdout { .print }
        # Supply is chunked, not line-based, so we can't just .note each time.
        whenever $proc.stderr { $*ERR.print: $_ }
        # Start the process, setting a working directory if specified. Await process and optionally replay exit code.
        whenever $proc.start: :$cwd {
            exit .exitcode unless $proceed;
        }
    }
}

# Display various prompts, obtaining input satisfyin given constraints and returning a hash of responses.
sub manage-prompt(@entries) is export {
    for @entries -> %entry {
        state %results;
        # An undefined constraint on input is replaced with the trivial /.+/ regex.
        repeat until %results{%entry<key>} ~~ %entry<constraint> // /.+/ {
            %results{%entry<key>} = prompt %entry<prompt>;
            LAST if %entry<normalize>.defined {
                %results{%entry<key>} = %entry<normalize>(%results{%entry<key>});
            }
        }
        LAST return %results;
    }
}

# This method of determining a user's requested actions may be retired.
# Additional specialized MAIN functions could replace the given/when dispatching.
sub parse-action($action, $commands) {
    return $commands.first: *.Str eq $action;
}

sub parse-guest-action($action) is export {
    parse-action($action, GuestCommand::.values);
}

sub parse-manage-action($action) is export {
    parse-action($action, ManageCommand::.values);
}

A  => resources/templates/docker-compose.tmpl +16 -0
@@ 1,16 @@
version: "3.7"
services:
  {{ guest }}:
    image: guest-{{ guest }}:live
    hostname: {{ hostname }}
    build: .
    restart: unless-stopped
    ports:
      - "{{ ssh_port }}:22"
    volumes:
      - type: volume
        source: guest-{{ guest }}
        target: /home/{{ user }}

volumes:
  guest-{{ guest }}:

A  => resources/templates/dockerfile.tmpl +14 -0
@@ 1,14 @@
FROM {{ base_image }}

RUN {{ package_manager }} {{ package_manager_update }} && {{ package_manager }} {{ package_manager_install }} {{ noconfirm }} openssh sudo vim audit
RUN useradd -m {{ user }} && echo '{{ user }}:{{ temporarypassword }}' chpasswd
RUN groupadd sudo && gpasswd -a {{ user }} sudo && echo '%sudo ALL=(ALL) NOPASSWD:ALL' >> /etc/sudoers

RUN ssh-keygen -A

RUN mkdir -p /home/{{ user }}/.ssh
RUN echo '{{ ssh_key }}' > /home/{{ user }}/.ssh/authorized_keys
COPY ssh/sshd_config /etc/ssh/sshd_config

EXPOSE 22
CMD ["/usr/sbin/sshd", "-D"]

A  => resources/templates/sshd_config.tmpl +122 -0
@@ 1,122 @@
#	$OpenBSD: sshd_config,v 1.103 2018/04/09 20:41:22 tj Exp $

# This is the sshd server system-wide configuration file.  See
# sshd_config(5) for more information.

# This sshd was compiled with PATH=/usr/bin:/bin:/usr/sbin:/sbin

# The strategy used for options in the default sshd_config shipped with
# OpenSSH is to specify options with their default value where
# possible, but leave them commented.  Uncommented options override the
# default value.

Port 22
#AddressFamily any
#ListenAddress 0.0.0.0
#ListenAddress ::

#HostKey /etc/ssh/ssh_host_rsa_key
#HostKey /etc/ssh/ssh_host_ecdsa_key
#HostKey /etc/ssh/ssh_host_ed25519_key

# Ciphers and keying
#RekeyLimit default none

# Logging
SyslogFacility AUTH
LogLevel INFO

# Authentication:

#LoginGraceTime 2m
#PermitRootLogin prohibit-password
#StrictModes yes
#MaxAuthTries 6
#MaxSessions 10

#PubkeyAuthentication yes

# The default is to check both .ssh/authorized_keys and .ssh/authorized_keys2
# but this is overridden so installations will only check .ssh/authorized_keys
#AuthorizedKeysFile	.ssh/authorized_keys

#AuthorizedPrincipalsFile none

#AuthorizedKeysCommand none
#AuthorizedKeysCommandUser nobody

# For this to work you will also need host keys in /etc/ssh/ssh_known_hosts
#HostbasedAuthentication no
# Change to yes if you don't trust ~/.ssh/known_hosts for
# HostbasedAuthentication
#IgnoreUserKnownHosts no
# Don't read the user's ~/.rhosts and ~/.shosts files
#IgnoreRhosts yes

# To disable tunneled clear text passwords, change to no here!
PasswordAuthentication no
#PermitEmptyPasswords no

# Change to no to disable s/key passwords
ChallengeResponseAuthentication no

# Kerberos options
#KerberosAuthentication no
#KerberosOrLocalPasswd yes
#KerberosTicketCleanup yes
#KerberosGetAFSToken no

# GSSAPI options
#GSSAPIAuthentication no
#GSSAPICleanupCredentials yes

# Set this to 'yes' to enable PAM authentication, account processing,
# and session processing. If this is enabled, PAM authentication will
# be allowed through the ChallengeResponseAuthentication and
# PasswordAuthentication.  Depending on your PAM configuration,
# PAM authentication via ChallengeResponseAuthentication may bypass
# the setting of "PermitRootLogin without-password".
# If you just want the PAM account and session checks to run without
# PAM authentication, then enable this but set PasswordAuthentication
# and ChallengeResponseAuthentication to 'no'.
UsePAM yes

#AllowAgentForwarding yes
#AllowTcpForwarding yes
#GatewayPorts no
#X11Forwarding no
#X11DisplayOffset 10
#X11UseLocalhost yes
#PermitTTY yes
PrintMotd no
PrintLastLog no
#TCPKeepAlive yes
#PermitUserEnvironment no
#Compression delayed
#ClientAliveInterval 0
#ClientAliveCountMax 3
#UseDNS no
#PidFile /run/sshd.pid
#MaxStartups 10:30:100
#PermitTunnel no
#ChrootDirectory none
#VersionAddendum none

# no default banner path
#Banner none

# override default of no subsystems
Subsystem	sftp	/usr/lib64/misc/sftp-server

# Example of overriding settings on a per-user basis
#Match User anoncvs
#	X11Forwarding no
#	AllowTcpForwarding no
#	PermitTTY no
#	ForceCommand cvs server

# Allow client to pass locale environment variables. #367017
AcceptEnv LANG LC_ALL LC_COLLATE LC_CTYPE LC_MESSAGES LC_MONETARY LC_NUMERIC LC_TIME LANGUAGE LC_ADDRESS LC_IDENTIFICATION LC_MEASUREMENT LC_NAME LC_PAPER LC_TELEPHONE

# Allow client to pass COLORTERM to match TERM. #658540
AcceptEnv COLORTERM