Crypt/Monkeysphere/Keytrans.pm

   1 package Crypt::Monkeysphere::Keytrans;
   2
   3 use strict;
   4 use warnings;
   5 use Math::BigInt;
   6 use Carp;
   7 use MIME::Base64;
   8
   9 use Exporter qw(import);
  10 our @EXPORT_OK=qw(GnuPGKey_to_OpenSSH_pub GnuPGKey_to_OpenSSH_fpr);
  11
  12
  13 # takes a Math::BigInt and returns it properly packed for openssh output.
  14
  15 sub openssh_mpi_pack {
  16   my $num = shift;
  17
  18   my $val = $num->as_hex();
  19   $val =~ s/^0x//;
  20   # ensure we've got an even multiple of 2 nybbles here.
  21   $val = '0'.$val
  22     if (length($val) % 2);
  23   $val = pack('H*', $val);
  24   # packed binary ones-complement representation of the value.
  25
  26   my $mpilen = length($val);
  27
  28   my $ret = pack('N', $mpilen);
  29
  30   # if the first bit of the leading byte is high, we should include a
  31   # 0 byte:
  32   if (ord($val) & 0x80) {
  33     $ret = pack('NC', $mpilen+1, 0);
  34   }
  35
  36   return $ret.$val;
  37 }
  38
  39 # this output is not base64-encoded yet.  Pass it through
  40 # encode_base64($output, '') if you want to make a file.
  41
  42 sub openssh_rsa_pubkey_pack {
  43   my ($modulus, $exponent) = @_;
  44
  45   return openssh_mpi_pack(Math::BigInt->new('0x'.unpack('H*', "ssh-rsa"))).
  46       openssh_mpi_pack($exponent).
  47         openssh_mpi_pack($modulus);
  48 }
  49
  50 # calculate/print the fingerprint of an openssh-style keyblob:
  51
  52 sub sshfpr {
  53   my $keyblob = shift;
  54   use Digest::MD5;
  55   return join(':', map({unpack("H*", $_)} split(//, Digest::MD5::md5($keyblob))));
  56 }
  57
  58 =pod
  59
  60 =head2 GnuPGKey_to_OpenSSH_fpr
  61
  62 Find the openssh compatible fingerprint of an (RSA) GnuPG::Key
  63
  64 B<Note> you will need to add add bits and (RSA) to the string to
  65 exactly match the output of ssh-keygen -l.
  66
  67 =head3 Arguments
  68
  69 key - GnuPG::Key object
  70
  71 =cut
  72
  73 sub GnuPGKey_to_OpenSSH_fpr {
  74   my $key = shift;
  75
  76   croak("not a GnuPG::Key!")
  77     unless($key->isa('GnuPG::Key'));
  78
  79   croak("Not an RSA key!")
  80     unless $key->algo_num == 1;
  81
  82   return sshfpr(openssh_rsa_pubkey_pack(@{$key->pubkey_data}), '');
  83 }
  84
  85 =pod
  86
  87 =head2 GnuPGKey_to_OpenSSH_pub
  88
  89 Translate a GnuPG::Key to a string suitable for an OpenSSH .pub file
  90
  91 B<Note> you will need to add "ssh-rsa " to the front to make OpenSSH
  92 recognize it.
  93
  94 =head3 Arguments
  95
  96 key - GnuPG::Key object
  97
  98 =cut
  99
 100 sub GnuPGKey_to_OpenSSH_pub {
 101   my $key = shift;
 102
 103   croak("not a GnuPG::Key!")
 104     unless($key->isa('GnuPG::Key'));
 105
 106   croak("Not an RSA key!")
 107     unless $key->algo_num == 1;
 108
 109   return encode_base64(openssh_rsa_pubkey_pack(@{$key->pubkey_data}), '');
 110 }
 111
 112 1;