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 { A D } {
  28   home_dir_on A H
  29   directory_in H '.ssh' D
  30   mode D '0700'
  31 }
  32
  33 rule authorized_keys_on { A F } {
  34   dot_ssh_on A D
  35   file_in D 'authorized_keys' F
  36   mode F '0600'
  37 }
  38
  39 rule key_installed_on { A K } {
  40   authorized_keys_on A F
  41   contains_line F K
  42 }
  43
  44 rule key_not_installed_on { A K } {
  45   authorized_keys_on A F
  46   not_contains_line F K
  47 }
  48
  49 rule my_config_dir D {
  50   home_dir_on '' H
  51   directory_in H '.keymangler' D
  52 }
  53
  54 rule my_config_file { C F } {
  55   my_config_dir D
  56   file_in D C F
  57 }
  58
  59 rule config_contains_line { C L } {
  60   my_config_file C F
  61   contains_line F L
  62 }
  63
  64 rule config_not_contains_line { C L } {
  65   my_config_file C F
  66   not_contains_line F L
  67 }
  68
  69 rule known_account A { config_contains_line 'accounts' A }
  70 rule known_key K { config_contains_line 'keys' K }
  71 rule known_dead D { config_contains_line 'keys.dead' D }
  72
  73 rule not_known_account A { config_not_contains_line 'accounts' A }
  74 rule not_known_key K { config_not_contains_line 'keys' K }
  75 rule not_known_dead D { config_not_contains_line 'keys.dead' D }
  76
  77 rule all_known_installed_on A {
  78   foreach K { known_key K } { key_installed_on A K }
  79 }
  80
  81 rule all_dead_not_installed_on A {
  82   foreach K { known_dead K } { key_not_installed_on A K }
  83 }
  84
  85 rule account_synchronized A {
  86   all_known_installed_on A
  87   all_dead_not_installed_on A
  88 }
  89
  90 rule all_synchronized {} {
  91   foreach A { known_account A } { account_synchronized A }
  92 }
  93
  94 rule unknown_installed_on { A K } {
  95   key_installed_on A K
  96   not { known_key K }
  97   not { known_dead K }
  98 }
  99
 100 rule known_installed_on { A K } {
 101   key_installed_on A K
 102   known_key K
 103 }
 104
 105 rule dead_installed_on { A K } {
 106   key_installed_on A K
 107   known_dead K
 108 }
 109
 110 oo::class create ConfigSet {
 111   constructor mytype {
 112     namespace import ::DX::*
 113     variable type $mytype
 114   }
 115   method learn V {
 116     variable type
 117     ensure "known_$type {'$V'}"
 118   }
 119   method forget V {
 120     variable type
 121     ensure "not_known_$type {'$V'}"
 122   }
 123   method list {} {
 124     variable type
 125     query* "known_$type V" {puts $V}
 126   }
 127 }
 128
 129 oo::class create KeyMangler {
 130   constructor {} {
 131     namespace import ::DX::*
 132     ConfigSet create key key
 133     ConfigSet create dead dead
 134     ConfigSet create account account
 135     variable mode ensure
 136   }
 137
 138   method key args { key {*}$args }
 139   method dead args { dead {*}$args }
 140   method account args { account {*}$args }
 141
 142   method status {} {
 143     query* {
 144       known_account A
 145       findall Known K { known_installed_on A K }
 146       findall Unknown U { unknown_installed_on A U }
 147       findall Dead D { dead_installed_on A D }
 148     } {
 149       puts "Host: $A"
 150       foreach k $Known { puts "  Known: [lindex $k 2]" }
 151       foreach u $Unknown { puts "  Unknown: [lindex $u 2]" }
 152       foreach d $Dead { puts "  Dead: [lindex $d 2]" }
 153       puts ""
 154     }
 155   }
 156
 157   method -n args {
 158     variable mode solve
 159     my {*}$args
 160   }
 161
 162   export -n
 163
 164   method sync {{account -}} {
 165     variable mode
 166     if {"$account" eq "-"} {
 167       $mode { all_synchronized }
 168     } else {
 169       $mode "account_synchronized {'$account'}"
 170     }
 171   }
 172 }
 173
 174 KeyMangler create km