1 package App::KeyMangler;
9 our $Tcl_Data ||= do { local $/; my $data = <DATA>; close(DATA); $data };
10 $self->tcl->Eval($Tcl_Data);
14 my ($self, @args) = @_;
16 my $res = $self->tcl->call(km => @args);
27 rule dot_ssh_on { Account DotSshDir } {
28 home_dir_on Account HomeDir
29 directory_in HomeDir '.ssh' DotSshDir
33 rule authorized_keys_on { Account AuthorizedKeysFile } {
34 dot_ssh_on Account DotSshDir
35 file_in DotSshDir 'authorized_keys' AuthorizedKeysFile
36 mode AuthorizedKeysFile '0600'
39 rule key_installed_on { Account PubKeyLine } {
40 authorized_keys_on Account AuthorizedKeysFile
41 contains_line AuthorizedKeysFile PubKeyLine
44 rule key_not_installed_on { Account PubKeyLine } {
45 authorized_keys_on Account AuthorizedKeysFile
46 not_contains_line AuthorizedKeysFile PubKeyLine
49 rule my_config_dir ConfigDir {
50 home_dir_on '' HomeDir
51 directory_in HomeDir '.keymangler' ConfigDir
54 rule my_config_file { ConfigType ConfigFile } {
55 my_config_dir ConfigDir
56 file_in ConfigDir ConfigType ConfigFile
59 rule config_contains_line { ConfigType Line } {
60 my_config_file ConfigType ConfigFile
61 contains_line ConfigFile Line
64 rule config_not_contains_line { ConfigType Line } {
65 my_config_file ConfigType ConfigFile
66 not_contains_line ConfigFile Line
69 rule known_account Account {
70 config_contains_line 'accounts' Account
74 config_contains_line 'keys' Key
76 rule known_dead DeadKey {
77 config_contains_line 'keys.dead' DeadKey
80 rule not_known_account Account {
81 config_not_contains_line 'accounts' Account
83 rule not_known_key Key {
84 config_not_contains_line 'keys' Key
86 rule not_known_dead DeadKey {
87 config_not_contains_line 'keys.dead' DeadKey
90 rule all_known_installed_on Account {
91 foreach Key { known_key Key } {
92 key_installed_on Account Key
96 rule all_dead_not_installed_on Account {
97 foreach Key { known_dead Key } {
98 key_not_installed_on Account Key
102 rule account_synchronized Account {
103 all_known_installed_on Account
104 all_dead_not_installed_on Account
107 rule all_synchronized {} {
108 foreach Account { known_account Account } {
109 account_synchronized Account
113 rule unknown_installed_on { Account Key } {
114 key_installed_on Account Key
115 not { known_key Key }
116 not { known_dead Key }
119 rule known_installed_on { Account Key } {
120 key_installed_on Account Key
124 rule dead_installed_on { Account Key } {
125 key_installed_on Account Key
129 oo::class create ConfigSet {
131 namespace import ::DX::*
132 variable type $mytype
136 ensure "known_$type {'$Value'}"
140 ensure "not_known_$type {'$Value'}"
144 query* "known_$type Value" {puts $Value}
148 oo::class create KeyMangler {
150 namespace import ::DX::*
151 ConfigSet create key key
152 ConfigSet create dead dead
153 ConfigSet create account account
157 method key args { key {*}$args }
158 method dead args { dead {*}$args }
159 method account args { account {*}$args }
163 known_account Account
164 findall KnownKeys Key {
165 known_installed_on Account Key
167 findall UnknownKeys Unknown {
168 unknown_installed_on Account Unknown
170 findall DeadKeys Dead {
171 dead_installed_on Account Dead
175 foreach key $KnownKeys {
176 puts " Known: [lindex $key 2]"
178 foreach unknown $UnknownKeys {
179 puts " Unknown: [lindex $unknown 2]"
181 foreach dead $DeadKeys {
182 puts " Dead: [lindex $dead 2]"
195 method push {{account -}} {
197 if {"$account" eq "-"} {
198 $mode { all_synchronized }
200 $mode "account_synchronized {'$account'}"
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}
212 puts { # What keys are installed where?}
215 puts { # Update remote authorized_keys files (-n is dry-run)}
216 puts { $ km [-n] sync user@host}
217 puts { $ km [-n] sync}