apps/tkca

   1 #!/usr/local/bin/perl5
   2 #
   3 # This is only something I'm playing with, it does not work :-)
   4 #
   5
   6 use Tk;
   7
   8 my $main=MainWindow->new();
   9 my $f=$main->Frame(-relief => "ridge", -borderwidth => 2);
  10 $f->pack(-fill => 'x');
  11
  12 my $ff=$f->Frame;
  13 $ff->pack(-fill => 'x');
  14 my $l=$ff->Label(-text => "TkCA - SSLeay",
  15         -relief => "ridge", -borderwidth => 2);
  16 $l->pack(-fill => 'x', -ipady => 5);
  17
  18 my $l=$ff->Button(-text => "Certify");
  19 $l->pack(-fill => 'x', -ipady => 5);
  20
  21 my $l=$ff->Button(-text => "Review");
  22 $l->pack(-fill => 'x', -ipady => 5);
  23
  24 my $l=$ff->Button(-text => "Revoke");
  25 $l->pack(-fill => 'x', -ipady => 5);
  26
  27 my $l=$ff->Button(-text => "Generate CRL");
  28 $l->pack(-fill => 'x', -ipady => 5);
  29
  30 my($db)=&load_db("demoCA/index.txt");
  31
  32 MainLoop;
  33
  34 sub load_db
  35         {
  36         my(%ret);
  37         my($file)=@_;
  38         my(*IN);
  39         my(%db_serial,%db_name,@f,@db_s);
  40
  41         $ret{'serial'}=\%db_serial;
  42         $ret{'name'}=\%db_name;
  43
  44         open(IN,"<$file") || die "unable to open $file:$!\n";
  45         while (<IN>)
  46                 {
  47                 chop;
  48                 s/([^\\])\t/\1\t\t/g;
  49                 my(@f)=split(/\t\t/);
  50                 die "wrong number of fields in $file, line $.\n"
  51                         if ($#f != 5);
  52
  53                 my(%f);
  54                 $f{'type'}=$f[0];
  55                 $f{'exp'}=$f[1];
  56                 $f{'rev'}=$f[2];
  57                 $f{'serial'}=$f[3];
  58                 $f{'file'}=$f[4];
  59                 $f{'name'}=$f[5];
  60                 die "serial number $f{'serial'} appears twice (line $.)\n"
  61                         if (defined($db{$f{'serial'}}))
  62                 $db_serial{$f{'serial'}}=\%f;
  63                 $db_name{$f{'name'}}.=$f{'serial'}." ";
  64                 }
  65         return \%ret;
  66         }