lib/App/KeyMangler.pm

   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
  27 rule dot_ssh_on { Account DotSshDir } {
  28   home_dir_on Account HomeDir
  29   directory_in HomeDir '.ssh' DotSshDir
  30   mode DotSshDir '0700'
  31 }
  32
  33 rule authorized_keys_on { Account AuthorizedKeysFile } {
  34   dot_ssh_on Account DotSshDir
  35   file_in DotSshDir 'authorized_keys' AuthorizedKeysFile
  36   mode AuthorizedKeysFile '0600'
  37 }
  38
  39 rule key_installed_on { Account PubKeyLine } {
  40   authorized_keys_on Account AuthorizedKeysFile
  41   contains_line AuthorizedKeysFile PubKeyLine
  42 }
  43
  44 rule key_not_installed_on { Account PubKeyLine } {
  45   authorized_keys_on Account AuthorizedKeysFile
  46   not_contains_line AuthorizedKeysFile PubKeyLine
  47 }
  48
  49 rule my_config_dir ConfigDir {
  50   home_dir_on '' HomeDir
  51   directory_in HomeDir '.keymangler' ConfigDir
  52 }
  53
  54 rule my_config_file { ConfigType ConfigFile } {
  55   my_config_dir ConfigDir
  56   file_in ConfigDir ConfigType ConfigFile
  57 }
  58
  59 rule config_contains_line { ConfigType Line } {
  60   my_config_file ConfigType ConfigFile
  61   contains_line ConfigFile Line
  62 }
  63
  64 rule config_not_contains_line { ConfigType Line } {
  65   my_config_file ConfigType ConfigFile
  66   not_contains_line ConfigFile Line
  67 }
  68
  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 }
  79
  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 }
  89
  90 rule all_known_installed_on Account {
  91   foreach Key { known_key Key } {
  92     key_installed_on Account Key
  93   }
  94 }
  95
  96 rule all_dead_not_installed_on Account {
  97   foreach Key { known_dead Key } {
  98     key_not_installed_on Account Key
  99   }
 100 }
 101
 102 rule account_synchronized Account {
 103   all_known_installed_on Account
 104   all_dead_not_installed_on Account
 105 }
 106
 107 rule all_synchronized {} {
 108   foreach Account { known_account Account } {
 109     account_synchronized Account
 110   }
 111 }
 112
 113 rule unknown_installed_on { Account Key } {
 114   key_installed_on Account Key
 115   not { known_key Key }
 116   not { known_dead Key }
 117 }
 118
 119 rule known_installed_on { Account Key } {
 120   key_installed_on Account Key
 121   known_key Key
 122 }
 123
 124 rule dead_installed_on { Account Key } {
 125   key_installed_on Account Key
 126   known_dead Key
 127 }
 128
 129 oo::class create ConfigSet {
 130   constructor mytype {
 131     namespace import ::DX::*
 132     variable type $mytype
 133   }
 134   method add Value {
 135     variable type
 136     ensure "known_$type {'$Value'}"
 137   }
 138   method rm Value {
 139     variable type
 140     ensure "not_known_$type {'$Value'}"
 141   }
 142   method list {} {
 143     variable type
 144     query* "known_$type Value" {puts $Value}
 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* {
 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       }
 173     } {
 174       puts "Host: $A"
 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       }
 184       puts ""
 185     }
 186   }
 187
 188   method -n args {
 189     variable mode solve
 190     my {*}$args
 191   }
 192
 193   export -n
 194
 195   method push {{account -}} {
 196     variable mode
 197     if {"$account" eq "-"} {
 198       $mode { all_synchronized }
 199     } else {
 200       $mode "account_synchronized {'$account'}"
 201     }
 202   }
 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   }
 220 }
 221
 222 KeyMangler create km