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