Commit | Line | Data |
91d1f239 |
1 | package App::KeyMangler; |
2 | |
3 | use Moo; |
4 | |
5 | extends 'DX::Tcl'; |
6 | |
7 | sub BUILD { |
8 | my ($self) = @_; |
9 | our $Tcl_Data ||= do { local $/; my $data = <DATA>; close(DATA); $data }; |
10 | $self->tcl->Eval($Tcl_Data); |
11 | } |
12 | |
13 | sub run { |
14 | my ($self, @args) = @_; |
15 | if (@args) { |
16 | my $res = $self->tcl->call(km => @args); |
17 | print $res; |
18 | } else { |
19 | $self->repl |
20 | } |
21 | } |
22 | |
23 | 1; |
24 | |
25 | __DATA__ |
26 | |
08c0734f |
27 | rule dot_ssh_on { Account DotSshDir } { |
28 | home_dir_on Account HomeDir |
29 | directory_in HomeDir '.ssh' DotSshDir |
30 | mode DotSshDir '0700' |
91d1f239 |
31 | } |
32 | |
08c0734f |
33 | rule authorized_keys_on { Account AuthorizedKeysFile } { |
34 | dot_ssh_on Account DotSshDir |
35 | file_in DotSshDir 'authorized_keys' AuthorizedKeysFile |
36 | mode AuthorizedKeysFile '0600' |
91d1f239 |
37 | } |
38 | |
08c0734f |
39 | rule key_installed_on { Account PubKeyLine } { |
40 | authorized_keys_on Account AuthorizedKeysFile |
41 | contains_line AuthorizedKeysFile PubKeyLine |
91d1f239 |
42 | } |
43 | |
08c0734f |
44 | rule key_not_installed_on { Account PubKeyLine } { |
45 | authorized_keys_on Account AuthorizedKeysFile |
46 | not_contains_line AuthorizedKeysFile PubKeyLine |
91d1f239 |
47 | } |
48 | |
08c0734f |
49 | rule my_config_dir ConfigDir { |
50 | home_dir_on '' HomeDir |
51 | directory_in HomeDir '.keymangler' ConfigDir |
91d1f239 |
52 | } |
53 | |
08c0734f |
54 | rule my_config_file { ConfigType ConfigFile } { |
55 | my_config_dir ConfigDir |
56 | file_in ConfigDir ConfigType ConfigFile |
91d1f239 |
57 | } |
58 | |
08c0734f |
59 | rule config_contains_line { ConfigType Line } { |
60 | my_config_file ConfigType ConfigFile |
61 | contains_line ConfigFile Line |
91d1f239 |
62 | } |
63 | |
08c0734f |
64 | rule config_not_contains_line { ConfigType Line } { |
65 | my_config_file ConfigType ConfigFile |
66 | not_contains_line ConfigFile Line |
91d1f239 |
67 | } |
68 | |
08c0734f |
69 | rule known_account Account { |
70 | config_contains_line 'accounts' Account |
71 | } |
72 | |
73 | rule known_key Key { |
74 | config_contains_line 'keys' Key |
75 | } |
76 | rule known_dead DeadKey { |
77 | config_contains_line 'keys.dead' DeadKey |
78 | } |
91d1f239 |
79 | |
08c0734f |
80 | rule not_known_account Account { |
81 | config_not_contains_line 'accounts' Account |
82 | } |
83 | rule not_known_key Key { |
84 | config_not_contains_line 'keys' Key |
85 | } |
86 | rule not_known_dead DeadKey { |
87 | config_not_contains_line 'keys.dead' DeadKey |
88 | } |
91d1f239 |
89 | |
08c0734f |
90 | rule all_known_installed_on Account { |
91 | foreach Key { known_key Key } { |
92 | key_installed_on Account Key |
93 | } |
91d1f239 |
94 | } |
95 | |
08c0734f |
96 | rule all_dead_not_installed_on Account { |
97 | foreach Key { known_dead Key } { |
98 | key_not_installed_on Account Key |
99 | } |
91d1f239 |
100 | } |
101 | |
08c0734f |
102 | rule account_synchronized Account { |
103 | all_known_installed_on Account |
104 | all_dead_not_installed_on Account |
91d1f239 |
105 | } |
106 | |
107 | rule all_synchronized {} { |
08c0734f |
108 | foreach Account { known_account Account } { |
109 | account_synchronized Account |
110 | } |
91d1f239 |
111 | } |
112 | |
08c0734f |
113 | rule unknown_installed_on { Account Key } { |
114 | key_installed_on Account Key |
115 | not { known_key Key } |
116 | not { known_dead Key } |
91d1f239 |
117 | } |
118 | |
08c0734f |
119 | rule known_installed_on { Account Key } { |
120 | key_installed_on Account Key |
121 | known_key Key |
91d1f239 |
122 | } |
123 | |
08c0734f |
124 | rule dead_installed_on { Account Key } { |
125 | key_installed_on Account Key |
126 | known_dead Key |
91d1f239 |
127 | } |
128 | |
129 | oo::class create ConfigSet { |
130 | constructor mytype { |
131 | namespace import ::DX::* |
132 | variable type $mytype |
133 | } |
08c0734f |
134 | method add Value { |
91d1f239 |
135 | variable type |
08c0734f |
136 | ensure "known_$type {'$Value'}" |
91d1f239 |
137 | } |
08c0734f |
138 | method rm Value { |
91d1f239 |
139 | variable type |
08c0734f |
140 | ensure "not_known_$type {'$Value'}" |
91d1f239 |
141 | } |
142 | method list {} { |
143 | variable type |
08c0734f |
144 | query* "known_$type Value" {puts $Value} |
91d1f239 |
145 | } |
146 | } |
147 | |
148 | oo::class create KeyMangler { |
149 | constructor {} { |
150 | namespace import ::DX::* |
151 | ConfigSet create key key |
152 | ConfigSet create dead dead |
153 | ConfigSet create account account |
154 | variable mode ensure |
155 | } |
156 | |
157 | method key args { key {*}$args } |
158 | method dead args { dead {*}$args } |
159 | method account args { account {*}$args } |
160 | |
161 | method status {} { |
162 | query* { |
08c0734f |
163 | known_account Account |
164 | findall KnownKeys Key { |
165 | known_installed_on Account Key |
166 | } |
167 | findall UnknownKeys Unknown { |
168 | unknown_installed_on Account Unknown |
169 | } |
170 | findall DeadKeys Dead { |
171 | dead_installed_on Account Dead |
172 | } |
91d1f239 |
173 | } { |
174 | puts "Host: $A" |
08c0734f |
175 | foreach key $KnownKeys { |
176 | puts " Known: [lindex $key 2]" |
177 | } |
178 | foreach unknown $UnknownKeys { |
179 | puts " Unknown: [lindex $unknown 2]" |
180 | } |
181 | foreach dead $DeadKeys { |
182 | puts " Dead: [lindex $dead 2]" |
183 | } |
91d1f239 |
184 | puts "" |
185 | } |
186 | } |
187 | |
188 | method -n args { |
189 | variable mode solve |
190 | my {*}$args |
191 | } |
192 | |
193 | export -n |
194 | |
08c0734f |
195 | method push {{account -}} { |
91d1f239 |
196 | variable mode |
197 | if {"$account" eq "-"} { |
198 | $mode { all_synchronized } |
199 | } else { |
200 | $mode "account_synchronized {'$account'}" |
201 | } |
202 | } |
08c0734f |
203 | |
204 | method help {} { |
205 | puts {Usage:} |
206 | puts {} |
207 | puts { # Config commands} |
208 | puts { $ km {key,dead,account} add 'new value'} |
209 | puts { $ km {key,dead,account} rm 'old value'} |
210 | puts { $ km {key,dead,account} list} |
211 | puts {} |
212 | puts { # What keys are installed where?} |
213 | puts { $ km status} |
214 | puts {} |
215 | puts { # Update remote authorized_keys files (-n is dry-run)} |
216 | puts { $ km [-n] sync user@host} |
217 | puts { $ km [-n] sync} |
218 | puts {} |
219 | } |
91d1f239 |
220 | } |
221 | |
222 | KeyMangler create km |