~mclehman/guestctl

ref: df04e7d259d451c65a6d0716b82af0ada5ce249a guestctl/bin/guestctl -rwxr-xr-x 5.6 KiB View raw
df04e7d2 — 0xFORDCOMMA Fix typo in manage-prompt comment. 1 year, 5 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
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>>;
}