src/tests/kas.pm

   1 # CMUCS AFStools
   2 # Copyright (c) 1996, Carnegie Mellon University
   3 # All rights reserved.
   4 #
   5 # See CMU_copyright.ph for use and distribution information
   6 #
   7 #: * kas.pm - Wrappers around KAS commands (authentication maintenance)
   8 #: * This module provides wrappers around the various kaserver commands
   9 #: * giving them a nice perl-based interface.  At present, this module
  10 #: * requires a special 'krbkas' which uses existing Kerberos tickets
  11 #: * which the caller must have already required (using 'kaslog').
  12 #:
  13
  14 package OpenAFS::kas;
  15 use OpenAFS::CMU_copyright;
  16 use OpenAFS::util qw(:DEFAULT :afs_internal);
  17 use OpenAFS::wrapper;
  18 use POSIX ();
  19 use Exporter;
  20
  21 $VERSION   = '';
  22 $VERSION   = '1.00';
  23 @ISA       = qw(Exporter);
  24 @EXPORT    = qw(&AFS_kas_create        &AFS_kas_setf
  25                 &AFS_kas_delete        &AFS_kas_setkey
  26                 &AFS_kas_examine       &AFS_kas_setpw
  27                 &AFS_kas_randomkey     &AFS_kas_stringtokey
  28                 &AFS_kas_list);
  29
  30 # Instructions to parse kas error messages
  31 @kas_err_parse = ( [ ' : \[.*\] (.*), wait one second$', '.' ],
  32                    [ ' : \[.*\] (.*) \(retrying\)$',     '.' ],
  33                    [ ' : \[.*\] (.*)',                   '-' ]);
  34
  35 # Instructions to parse attributes of an entry
  36 @kas_entry_parse = (
  37     [ '^User data for (.*) \((.*)\)$',      'princ', 'flags', '.'        ],
  38     [ '^User data for (.*)',                'princ'                      ],
  39     [ 'key \((\d+)\) cksum is (\d+),',      'kvno', 'cksum'              ],
  40     [ 'last cpw: (.*)',                     \&parsestamp, 'stamp_cpw'    ],
  41     [ 'password will (never) expire',       'stamp_pwexp'                ],
  42     [ 'password will expire: ([^\.]*)',     \&parsestamp, 'stamp_pwexp'  ],
  43     [ 'An (unlimited) number of',           'max_badauth'                ],
  44     [ '(\d+) consecutive unsuccessful',     'max_badauth'                ],
  45     [ 'for this user is ([\d\.]+) minutes', 'locktime'                   ],
  46     [ 'for this user is (not limited)',     'locktime'                   ],
  47     [ 'User is locked (forever)',           'locked'                     ],
  48     [ 'User is locked until (.*)',          \&parsestamp, 'locked'       ],
  49     [ 'entry (never) expires',              'stamp_expire'               ],
  50     [ 'entry expires on ([^\.]*)\.',        \&parsestamp, 'stamp_expire' ],
  51     [ 'Max ticket lifetime (.*) hours',     'maxlife'                    ],
  52     [ 'Last mod on (.*) by',                \&parsestamp, 'stamp_update' ],
  53     [ 'Last mod on .* by (.*)',             'last_writer'                ]);
  54
  55
  56 @Months = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
  57            'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
  58 %Months = map(($Months[$_] => $_), 0..11);
  59
  60 # Parse a timestamp
  61 sub parsestamp {
  62   my($stamp) = @_;
  63   my($MM, $DD, $YYYY, $hh, $mm, $ss);
  64
  65   if ($stamp =~ /^\S+ (\S+) (\d+) (\d+):(\d+):(\d+) (\d+)/) {
  66     ($MM, $DD, $hh, $mm, $ss, $YYYY) = ($1, $2, $3, $4, $5, $6);
  67     $YYYY -= 1900;
  68     $MM = $Months{$MM};
  69     if (defined($MM)) {
  70       $stamp = POSIX::mktime($ss, $mm, $hh, $DD, $MM, $YYYY);
  71     }
  72   }
  73   $stamp;
  74 }
  75
  76
  77 # Turn an 8-byte key into a string we can give to kas
  78 sub stringize_key {
  79   my($key) = @_;
  80   my(@chars) = unpack('CCCCCCCC', $key);
  81
  82   sprintf("\\%03o" x 8, @chars);
  83 }
  84
  85
  86 # Turn a string into an 8-byte DES key
  87 sub unstringize_key {
  88   my($string) = @_;
  89   my($char, $key);
  90
  91   while ($string ne '') {
  92     if ($string =~ /^\\(\d\d\d)/) {
  93       $char = $1;
  94       $string = $';
  95       $key .= chr(oct($char));
  96     } else {
  97       $key .= substr($string, 0, 1);
  98       $string =~ s/^.//;
  99     }
 100   }
 101   $key;
 102 }
 103
 104
 105 #: AFS_kas_create($princ, $initpass, [$cell])
 106 #: Create a principal with name $princ, and initial password $initpass
 107 #: If specified, work in $cell instead of the default cell.
 108 #: On success, return 1.
 109 #:
 110 $AFS_Help{kas_create} = '$princ, $initpass, [$cell] => Success?';
 111 sub AFS_kas_create {
 112   my($print, $initpass, $cell) = @_;
 113   my(@args, $id);
 114
 115   @args = ('create', '-name', $princ, '-initial_password', $initpass);
 116   push(@args, '-noauth')           if ($AFS_Parms{'authlvl'} == 0);
 117   push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'});
 118   &wrapper('krbkas', \@args, [ @kas_err_parse ]);
 119   1;
 120 }
 121
 122
 123 #: AFS_kas_delete($princ, [$cell])
 124 #: Delete the principal $princ.
 125 #: If specified, work in $cell instead of the default cell.
 126 #: On success, return 1.
 127 #:
 128 $AFS_Help{kas_delete} = '$princ, [$cell] => Success?';
 129 sub AFS_kas_delete {
 130   my($princ, $cell) = @_;
 131   my(@args);
 132
 133   @args = ('delete', '-name', $princ);
 134   push(@args, '-noauth')           if ($AFS_Parms{'authlvl'} == 0);
 135   push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'});
 136   &wrapper('krbkas', \@args, [ @kas_err_parse ]);
 137   1;
 138 }
 139
 140
 141 #: AFS_kas_examine($princ, [$cell])
 142 #: Examine the prinicpal $princ, and return information about it.
 143 #: If specified, operate in cell $cell instead of the default cell.
 144 #: On success, return an associative array with some or all of the following:
 145 #: - princ        Name of this principal
 146 #: - kvno         Key version number
 147 #: - cksum        Key checksum
 148 #: - maxlife      Maximum ticket lifetime (in hours)
 149 #: - stamp_expire Time this principal expires, or 'never'
 150 #: - stamp_pwexp  Time this principal's password expires, or 'never'
 151 #: - stamp_cpw    Time this principal's password was last changed
 152 #: - stamp_update Time this princiapl was last modified
 153 #: - last_writer  Administrator who last modified this principal
 154 #: - max_badauth  Maximum number of bad auth attempts, or 'unlimited'
 155 #: - locktime     Penalty time for bad auth (in minutes), or 'not limited'
 156 #: - locked       Set and non-empty if account is locked
 157 #: - expired      Set and non-empty if account is expired
 158 #: - flags        Reference to a list of flags
 159 #:
 160 $AFS_Help{kas_examine} = '$princ, [$cell] => %info';
 161 sub AFS_kas_examine {
 162   my($vol, $cell) = @_;
 163   my(%result, @args, $flags);
 164
 165   @args = ('examine', '-name', $princ);
 166   push(@args, '-noauth')           if ($AFS_Parms{'authlvl'} == 0);
 167   push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'});
 168   %result = &wrapper('krbkas', \@args, [ @kas_err_parse, @kas_entry_parse ]);
 169
 170   if ($result{flags}) {
 171     $result{expired} = 1 if ($result{flags} =~ /expired/);
 172     $result{flags} = [ split(/\+/, $result{flags}) ];
 173   }
 174   %result;
 175 }
 176
 177
 178 #: AFS_kas_list([$cell])
 179 #: Get a list of principals in the kaserver database
 180 #: If specified, work in $cell instead of the default cell.
 181 #: On success, return an associative array whose keys are names of kaserver
 182 #: principals, and each of whose values is an associative array describing
 183 #: the corresponding principal, containing some or all of the same elements
 184 #: that may be returned by AFS_kas_examine
 185 #:
 186 $AFS_Help{kas_list} = '[$cell] => %princs';
 187 sub AFS_kas_list {
 188   my($cell) = @_;
 189   my(@args, %finres, %plist);
 190
 191   @args = ('list', '-long');
 192   push(@args, '-noauth')           if ($AFS_Parms{'authlvl'} == 0);
 193   push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'});
 194   %finres = &wrapper('krbkas', \@args,
 195     [ @kas_err_parse,
 196     [ '^User data for (.*)', sub {
 197       my(%pinfo) = %OpenAFS::wrapper::result;
 198
 199       if ($pinfo{name}) {
 200         $plist{$pinfo{name}} = \%pinfo;
 201         %OpenAFS::wrapper::result = ();
 202       }
 203     }],
 204       @kas_entry_parse ]);
 205
 206   if ($finres{name}) {
 207     $plist{$finres{name}} = \%finres;
 208   }
 209   %plist;
 210 }
 211
 212
 213 #: AFS_kas_setf($princ, \%attrs, [$cell])
 214 #: Change the attributes of the principal $princ.
 215 #: If specified, operate in cell $cell instead of the default cell.
 216 #: The associative array %attrs specifies the attributes to change and
 217 #: their new values.  Any of the following attributes may be changed:
 218 #: - flags        Entry flags
 219 #: - expire       Expiration time (mm/dd/yy)
 220 #: - lifetime     Maximum ticket lifetime (seconds)
 221 #: - pwexpires    Maximum password lifetime (days)
 222 #: - reuse        Permit password reuse (yes/no)
 223 #: - attempts     Maximum failed authentication attempts
 224 #: - locktime     Authentication failure penalty (minutes or hh:mm)
 225 #:
 226 #: On success, return 1.
 227 #:
 228 $AFS_Help{kas_setf} = '$princ, \%attrs, [$cell] => Success?';
 229 sub AFS_kas_setf {
 230   my($princ, $attrs, $cell) = @_;
 231   my(%result, @args);
 232
 233   @args = ('setfields', '-name', $princ);
 234   push(@args, '-flags',      $$attrs{flags})     if ($$attrs{flags});
 235   push(@args, '-expiration', $$attrs{expire})    if ($$attrs{expire});
 236   push(@args, '-lifetime',   $$attrs{lifetime})  if ($$attrs{lifetime});
 237   push(@args, '-pwexpires',  $$attrs{pwexpires}) if ($$attrs{pwexpires});
 238   push(@args, '-reuse',      $$attrs{reuse})     if ($$attrs{reuse});
 239   push(@args, '-attempts',   $$attrs{attempts})  if ($$attrs{attempts});
 240   push(@args, '-locktime',   $$attrs{locktime})  if ($$attrs{locktime});
 241   push(@args, '-noauth')           if ($AFS_Parms{'authlvl'} == 0);
 242   push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'});
 243   &wrapper('krbkas', \@args, [ @kas_err_parse ]);
 244   1;
 245 }
 246
 247
 248 #: AFS_kas_setkey($princ, $key, [$kvno], [$cell])
 249 #: Change the key of principal $princ to the specified value.
 250 #: $key is the 8-byte DES key to use for this principal.
 251 #: If specified, set the key version number to $kvno.
 252 #: If specified, operate in cell $cell instead of the default cell.
 253 #: On success, return 1.
 254 #:
 255 $AFS_Help{kas_setkey} = '$princ, $key, [$kvno], [$cell] => Success?';
 256 sub AFS_kas_setkey {
 257   my($princ, $key, $kvno, $cell) = @_;
 258   my(@args);
 259
 260   @args = ('setkey', '-name', $princ, '-new_key', &stringize_key($key));
 261   push(@args, '-kvno', $kvno) if (defined($kvno));
 262   push(@args, '-noauth')           if ($AFS_Parms{'authlvl'} == 0);
 263   push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'});
 264   &wrapper('krbkas', \@args, [ @kas_err_parse ]);
 265   1;
 266 }
 267
 268
 269 #: AFS_kas_setpw($princ, $password, [$kvno], [$cell])
 270 #: Change the key of principal $princ to the specified value.
 271 #: $password is the new password to use.
 272 #: If specified, set the key version number to $kvno.
 273 #: If specified, operate in cell $cell instead of the default cell.
 274 #: On success, return 1.
 275 #:
 276 $AFS_Help{kas_setpw} = '$princ, $password, [$kvno], [$cell] => Success?';
 277 sub AFS_kas_setpw {
 278   my($princ, $password, $kvno, $cell) = @_;
 279   my(@args);
 280
 281   @args = ('setpasswd', '-name', $princ, '-new_password', $password);
 282   push(@args, '-kvno', $kvno) if (defined($kvno));
 283   push(@args, '-noauth')           if ($AFS_Parms{'authlvl'} == 0);
 284   push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'});
 285   &wrapper('krbkas', \@args, [ @kas_err_parse ]);
 286   1;
 287 }
 288
 289
 290 #: AFS_kas_stringtokey($string, [$cell])
 291 #: Convert the specified string to a DES key
 292 #: If specified, operate in cell $cell instead of the default cell.
 293 #: On success, return the resulting key
 294 $AFS_Help{kas_stringtokey} = '$string, [$cell] => $key';
 295 sub AFS_kas_stringtokey {
 296   my($string, $cell) = @_;
 297   my(@args, $key);
 298
 299   @args = ('stringtokey', '-string', $string);
 300   push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'});
 301   &wrapper('krbkas', \@args,
 302     [ @kas_err_parse,
 303       [ q/^Converting .* in realm .* yields key='(.*)'.$/, \$key ]]);
 304   &unstringize_key($key);
 305 }
 306
 307
 308 #: AFS_kas_randomkey([$cell])
 309 #: Ask the kaserver to generate a random DES key
 310 #: If specified, operate in cell $cell instead of the default cell.
 311 #: On success, return the resulting key
 312 $AFS_Help{kas_randomkey} = '[$cell] => $key';
 313 sub AFS_kas_randomkey {
 314   my($cell) = @_;
 315   my(@args, $key);
 316
 317   @args = ('getrandomkey');
 318   push(@args, '-cell', $cell ? $cell : $AFS_Parms{'cell'});
 319   &wrapper('krbkas', \@args,
 320     [ @kas_err_parse,
 321       [ '^Key: (\S+)', \$key ]]);
 322   &unstringize_key($key);
 323 }
 324
 325 1;