#! /usr/bin/perl

use strict ;
use warnings ;
use 5.008008 ;

package Wotsap ;

use File::Path qw(mkpath) ;
use LWP::UserAgent ;
use Digest::MD5 ;
use Carp qw(confess) ;
use DBI ;
use DBD::SQLite ;

our $VERSION = '0.02.09' ;

use constant { PROG    => 'Wotsap' } ;

sub as_kid
  { OBB::A_ge ( 1, scalar @_ ) ;
    my @res = map { ref ( $_ ) ? $_ -> kid : $_ } @_ ;
    @_ == 1 ? shift @res : @res ;
  }

sub mk_key
  { OBB::A_is ( 2, scalar @_ ) ;
    my $self = shift ;
    Wotsap::Key -> Make ( kid => shift, tabl => $self -> keys ) ;
  }

sub refresh
  { OBB::A_is ( 2, scalar @_ ) ;
    my $self = shift ;
    my $key  = shift ;
    $key -> refresh ( $self ) ;
  }

sub Version { sprintf "%s-%s", PROG, $VERSION ; }

###################################################################
package OBB ;

# use base 'OBB' ; __PACKAGE__ -> mk_getset ( qw(col ...) ) ;

use constant VLVLS => qw(Silent Quiet Terse Verbose Debug) ;
our %VLVLS = () ;
{ my $cnt = 1 ; $VLVLS { $_ } = $cnt ++ for ( VLVLS ) ; }
{ my $cnt = 1 ; for ( VLVLS ) { $VLVLS { $cnt } = $cnt ; $cnt ++ ; } }
sub _VLVL { $VLVLS { shift @_ } ; }
our $Verbosity = $VLVLS { Terse } ;
# get Verbosity ; or set Verbosity and return previous Verbosity
sub Verbosity
  { my $self = shift ;
    my $res  = $Verbosity ;
    if ( @_ )
      { my $tmp = shift @_ ;
        my $lvl = $VLVLS { $tmp } ; die "bad level $tmp" unless $lvl ;
        $Verbosity = $lvl ;
      }
    $res ;
  }
eval sprintf 'sub %s { $Verbosity >= $VLVLS { %s } ; }', $_, $_ for VLVLS ;

sub mk_getset
  { my $self = shift ;
    my @bads = grep ! /^[A-Za-z_]\w*$/, @_ ; die "bad col [@bads]\n" if @bads ;
    my $sub  = <<'SUB' ;
sub %s::%s { my $self = shift ; $self -> {%s} = shift if @_ ; $self -> {%s} ; }
SUB
    eval sprintf $sub, $self, $_, $_, $_ for @_ ;
  }
sub New  { my $self = shift ; bless { _err => '' }, $self ; }
sub Defs { () ; }
sub Init
  { Carp::confess ( 'Init : odd #args' ) unless @_ % 2 ;
    my $self = shift ;
    my %opts = ( $self -> Defs, @_ ) ;
    my @opts = keys %opts ;
    @$self { @opts } = @opts { @opts } ;
    $self ;
  }
sub Make  { my $self = shift ; $self -> New -> Init ( @_ ) ; }
sub Reset { my $self = shift ; $self -> _err ( '' ) ; $self ; }
sub Err   { my $self = shift ; $self -> _err ( @_ ) ; }
sub Die
  { my $self = shift ; my $fmt = shift ; chomp $fmt ;
    die sprintf "[err] $fmt\n", @_ ;
  }
sub Xit
  { my $self = shift ; my $fmt = shift ; chomp $fmt ;
    Carp::confess ( sprintf "$fmt\n", @_ ) ;
  }
sub A_is { Carp::confess ( "! #args == $_[0]" ) unless $_[1] == $_[0] ; }
sub A_ge { Carp::confess ( "! #args >= $_[0]" ) unless $_[1] >= $_[0] ; }
sub A_in
  { A_is 3, scalar @_ ;
    my ( $lo, $hi, $sz ) = @_ ;
    Carp::confess ( "! #args in [$lo,$hi]" ) unless $lo <= $sz and $sz <= $hi ;
  }

sub _TX
  { my $fmt = shift || 'TX' ; chomp $fmt ;
    my $txt =
      ( @_
      ? sprintf $fmt, map
          { ( ref $_ and $_ -> can ( 'diag' ) )
          ? $_ -> diag
          : Util::diag ( $_ )
          } @_
      : $fmt
      ) ;
    print "$txt\n" ;
  }

sub TV { _TX @_ if OBB -> Verbose ; }
sub TD { _TX @_ if OBB -> Debug   ; }

__PACKAGE__ -> mk_getset ( qw(_err) ) ;

1 ;

###################################################################
package Util ;

sub diag
  { my $x = shift ;
    unless ( defined $x )
      { '<undef>' ; }
    elsif ( ref $x and $x -> can ( 'diag' ) )
      { sprintf '[%s]', $x -> diag ; }
    elsif ( $x eq '' )
      { '<empty>' ; }
    else
      { $x =~ s/\n/\\n/g unless ref $x ;
        my $l = length ( $x ) ; my $c = $l < 1000 ;
        sprintf '[%s]', $c ? $x : substr ( $x, 0, 48 ) . "...($l)"  ;
      }
  }

###################################################################
package Wotsap ;

use base 'OBB' ;
__PACKAGE__ -> mk_getset ( qw(path serv dbh keys sigs meta cache) ) ;

use constant KEY_LEN => 16 ;
use constant
  { NO      => ''
  , DEFROOT => '8b962943fc243f3c'
  , FS_TEMP => 'tmp'
  , FS_SINK => '.sink'
  , FS_CDIR => 'cache'
  , FS_LITE => 'wotsap.lite'
  , FS_EXPT => 'export'
  , FS_NAMS => 'names'
  , FS_KEYS => 'keys'
  , FS_SIGS => 'signatures'
  , FS_WOTF => 'import.wot'
  , FS_WOTV => 'WOTVERSION'
  , FS_READ => 'README'
  , DB_IMPT => 'import'
  , DB_EXPT => 'export'
  , DB_FNDR => 'finder'
  , SUM_DEF => 'BLCINIT' . '0' x ( KEY_LEN - length 'BLCINIT' )
  , SUM_NOB => 'NOBLOCK' . '0' x ( KEY_LEN - length 'NOBLOCK' )
  , SUM_BAD => 'BAD_KID' . '0' x ( KEY_LEN - length 'BAD_KID' )
  , SORT_WD => 'kid'
  , MAX_PATHS => 8
  , REDO_INCR => 27 * 24 * 3600
  } ;
use constant
  { FS_KEYS_TXT => FS_KEYS . '.txt'
  , FS_SIGS_TXT => FS_SIGS . '.txt'
  , EXPORT_WOT  => FS_EXPT . '.wot'
  } ;

sub KID_LEN { my $version = shift ; $version eq '0.3' ? KEY_LEN : 8 ; }

sub p4
  { my $path = shift -> path ;
    my @res  = map { sprintf '%s/%s', $path, $_ } @_ ;
    wantarray ? @res : shift @res ;
  }

sub p_temp { $_[0] -> p4 ( FS_TEMP ) ; }
sub p_sink { $_[0] -> p4 ( FS_SINK ) ; }
sub p_lite { $_[0] -> p4 ( FS_LITE ) ; }
sub p_cdir { $_[0] -> p4 ( FS_CDIR ) ; }
sub p_expt { $_[0] -> p4 ( FS_EXPT ) ; }
sub p_nams { $_[0] -> p4 ( FS_NAMS ) ; }
sub p_keys { $_[0] -> p4 ( FS_KEYS ) ; }
sub p_sigs { $_[0] -> p4 ( FS_SIGS ) ; }
sub p_wotf { $_[0] -> p4 ( FS_WOTF ) ; }
sub p_wotv { $_[0] -> p4 ( FS_WOTV ) ; }
sub p_read { $_[0] -> p4 ( FS_READ ) ; }
sub p_keyt { $_[0] -> p4 ( FS_KEYS_TXT ) ; }
sub p_sigt { $_[0] -> p4 ( FS_SIGS_TXT ) ; }
sub p_expw { $_[0] -> p4 ( EXPORT_WOT  ) ; }

sub is_a_wd
  { my $self = shift ;
    my $wdir = shift ;
    my $any  = 0 ;
    $any ||= -e "$wdir/$_" for ( FS_TEMP, FS_SINK, FS_LITE ) ;
    $any ;
  }

sub ok_type
  { my $want = shift ;
    my $have = shift ;
    return 1 unless $want and $have ;
    return 1 if $want eq $have ;
    return 1 if $want eq DB_IMPT and $have eq DB_FNDR ;
#   return 1 if $want eq DB_FNDR and $have eq DB_IMPT ;
    return 0 ;
  }

sub ok_vers
  { my $want = shift ;
    my $have = shift ;
    return 0 if $want and $have and $want ne $have ;
    return 1 ;
  }

sub Require
  { my $self = shift ;
    my %opts =
      ( version => ''
      , db_type => ''
      , @_
      ) ;
    my $want_type = $opts {db_type} ;
    my $want_vers = $opts {version} ;
    my $have_type = $self -> meta -> db_type ;
    my $have_vers = $self -> meta -> version ;
    OBB::TV ( "Require : opts db_type %s", $want_type ) ;
    OBB::TV ( "Require : opts version %s", $want_vers ) ;
    OBB::TV ( "Require : meta db_type %s", $have_type ) ;
    OBB::TV ( "Require : meta version %s", $have_vers ) ;
    my $ok_type = ok_type $want_type, $have_type ;
    my $ok_vers = ok_vers $want_vers, $have_vers ;
    my @err ;
    push @err, "want db_type '$want_type' ; have '$have_type'"
      unless $ok_type ;
    push @err, "want version '$want_vers' ; have '$have_vers'"
      unless $ok_vers ;
    $self -> Die ( join "\n[err] ", @err ) if @err ;

    my $upd = 0 ;
    if ( ! $have_type and $want_type and $want_type ne $have_type )
      { OBB::TV ( "set db_type %s", $want_type ) ;
        $self -> meta -> db_type ( $want_type ) ;
        $upd ++ ;
      }
    if ( ! $have_vers and $want_vers and $want_vers ne $have_vers )
      { OBB::TV ( "set version %s", $want_vers ) ;
        $self -> meta -> version ( $want_vers ) ;
        $upd ++ ;
      }
    $self -> mk_tabs if $upd ;
    $self ;
  }

sub Init
  { my $self = shift ;
    my %opts =
      ( kserver => ''
      , @_
      ) ;
    $self -> OBB::Init ( %opts ) ;
    my $path = $self -> path ;
    $self -> Xit ( "path ($path) is emtpy" ) unless $path ;
    -d $path or mkpath $path, 0, 0755 ;
    -d $self -> p_sink or mkpath $self -> p_sink, 0, 0700 ;
    -d $self -> p_temp or mkpath $self -> p_temp, 0, 0755 ;
    $self -> dbh ( $self -> mk_dbh ) ;
    $self -> mk_meta ;
    $self -> Require ( %opts ) ;
    $self -> mk_tabs ;
    my $ksrv = $opts { kserver } ;
    $self -> meta -> kserver ( $ksrv ) if $ksrv ;
    $self -> mk_keyserver ;
    $self ;
  }

sub add_cache
  { my $self = shift ;
    my $days = shift ;
    $self -> cache ( Wotsap::Cache -> Make ( base => $self, days => $days ) ) ;
  }

sub mk_keyserver
  { my $self = shift ;
    my $ksrv = $self -> meta -> kserver ;
    my $gpg  = $self -> meta -> prg_gpg ;
    unless ( $ksrv )
      { undef ; }
    elsif ( $ksrv =~ m!/! )
      { $self -> serv
          ( Wotsap::Keyring -> Make ( path => $ksrv, gpg => $gpg ) ) ;
      }
    else
      { $self -> serv ( Wotsap::Keyserver -> Make ( fqdn => $ksrv ) ) ; }
  }

sub bad_kid
  { my $self = shift ;
    my $kid  = shift ;
    my $len  = $self -> kid_len ;
    ( ( length $kid != $len )
    ? "bad length kid '$kid' ; should be $len"
    : ( $kid !~ /^[a-f0-9]*$/ ? "bad chars in kid $kid" : '' )
    ) ;
  }

sub rootkid
  { my $self = shift ;
    if ( @_ )
      { my $root = shift ;
        my $err = $self -> bad_kid ( $root ) ;
        if ( $err ) { $self -> Xit ( $err ) ; }
        $self -> meta -> rootkid ( $root ) ;
      }
    $self -> meta -> rootkid ;
  }

sub rootkey { my $self = shift ; $self -> key ( $self -> rootkid ) ; }

sub mk_dbh
  { my $self = shift ;
    my $path = $self -> p_lite ;
    OBB::TD "connecting to %s ...", $path ;
    my $dbh = DBI -> connect
      ( "dbi:SQLite:dbname=$path", "", ""
      , { AutoCommit => 1 , RaiseError => 1 }
      ) or $self -> Xit ( "can't mk_dbh $path" ) ;
    $dbh -> do ( 'PRAGMA foreign_keys = ON' ) or $self -> Xitdb ;
    $dbh -> do ( 'PRAGMA cache_size=8800000' ) or $self -> Xitdb ;
    $dbh -> do ( 'PRAGMA case_sensitive_like=1' ) or $self -> Xitdb ;
    $dbh ;
  }

sub mk_meta
  { my $self = shift ;
    my $sql = "CREATE TABLE IF NOT EXISTS meta ( version text )" ;
    $self -> query ( $sql ) or $self -> Xitdb ;
    $self -> add_tab ( 'meta' ) ;
    $self -> meta -> mk_cols ;
    $self -> query ( "INSERT INTO meta (version) VALUES ('')" )
      unless $self -> meta -> count ;
    $self ;
  }

sub mk_tabs
  { my $self = shift ;
    my $path = $self -> p_lite ;
    my $type = $self -> meta -> db_type ;
    my $vers = $self -> meta -> version ;

    OBB::TV ( 'mk_tabs : db_type %s', $type ) ;
    OBB::TV ( 'mk_tabs : version %s', $vers ) ;

    return unless $vers and $type ;
#   unless ( $vers )
#     { print "mk_tabs : no version\n" ; return ; }
#   unless ( $type )
#     { print "mk_tabs : no db_type\n" ; return ; }

    my $refs = "REFERENCES keys ON DELETE CASCADE" ;
    my $kid =
      ( $vers eq '0.3'
      ? 'CHECK ( length(kid) = 16 ) UNIQUE'
      : 'CHECK ( length(kid) =  8 )'
      ) ;
    my $dbh = $self -> dbh ;

    my $XTRAS = <<XTRAS ;
  , sum  text NOT NULL CHECK ( length(sum) = 32 ) UNIQUE
  , bad  text NOT NULL DEFAULT ''
  , done integer DEFAULT NULL
  , wid  integer DEFAULT NULL
  , redo integer DEFAULT NULL
XTRAS
   $XTRAS = '' unless $type eq Wotsap::DB_EXPT ;

    my $CREAS = <<CREAS ;
CREATE TABLE IF NOT EXISTS meta ( version text DEFAULT NULL )
---
CREATE TABLE IF NOT EXISTS keys
  ( id INTEGER PRIMARY KEY NOT NULL
  , kid text NOT NULL $kid
  , uid text NOT NULL DEFAULT 'unknown'
$XTRAS
  )
---
CREATE TABLE IF NOT EXISTS sigs
  ( src integer NOT NULL $refs
  , dst integer NOT NULL $refs
  , lvl integer NOT NULL DEFAULT 0 CHECK ( 0 <= lvl AND lvl <= 7 )
  , PRIMARY KEY ( src, dst )
  )
---
CREATE INDEX IF NOT EXISTS sigs_src_idx ON sigs ( src )
---
CREATE INDEX IF NOT EXISTS sigs_dst_idx ON sigs ( dst )
CREAS

    my @CREAS = split /---\n/s, $CREAS ;
    push @CREAS, 'CREATE INDEX IF NOT EXISTS keys_kid_idx ON keys ( kid )'
      if $vers eq '0.2' ;
    push @CREAS, 'CREATE INDEX IF NOT EXISTS keys_done_idx ON keys ( done )'
      if $type eq Wotsap::DB_EXPT ;
    for my $sql ( @CREAS )
      { chomp $sql ; $dbh -> do ( $sql ) or $self -> Xitdb ; }

    $self -> add_tab ( 'keys' ) ;
    $self -> add_tab ( 'sigs' ) ;
#   $self -> meta -> version ( $vers ) unless $self -> meta -> version ;
#   $self -> meta -> db_type ( $type ) unless $self -> meta -> db_type ;
    $self ;
  }

sub path4bloc
  { my $self = shift ;
    sprintf "%s/key", $self -> p_temp ;
  }
sub path4last { my $self = shift ; sprintf "%s/last.key", $self -> p_temp ; }

sub add_tab
  { my $self = shift ;
    my $name = lc shift ;
    my $pack = sprintf '%s::%s', ref ( $self ), ucfirst $name ;
    my $tab  = $pack -> Make ( base => $self, name => $name ) ;
    $self -> $name ( $tab ) ;
  }

sub wot_version
  { my $self = shift ;
    my $file = $self -> p_wotv ;
    my $res  = '' ;
    if ( -f $file )
      { open FIL, $file or die "can't open $file ($!)" ;
        $res = <FIL> ;
        close FIL ;
        chomp $res ;
      }
    $res ;
  }

sub Xitdb { my $self = shift ; $self -> Xit ( $self -> dbh -> errstr ) ; }

sub kid_len { my $self = shift ; KID_LEN ( $self -> meta -> version ) ; }

sub key
  { my $self = shift ;
    my $kid  = Wotsap::as_kid shift ;
    $self -> keys -> select1 ( where => "kid = ?", args => [ [ $kid ] ] ) ;
  }

sub find_key_args
  { my $self = shift ;
    my $kid  = shift ;
    ( 'kid LIKE ?', '%' . $kid ) ;
  }

sub find_keys
  { my $self = shift ;
    my $kid  = lc shift ; $kid =~ s/^0x// ;
    my $len  = $self -> kid_len ;
    my $qwe  = 'kid = ?' ;
    my $arg  = $kid ;
    if ( length $kid > $len )
      { $arg = substr $kid, - $len ; }
    if ( length $kid < $len )
      { ( $qwe, $arg ) = $self -> find_key_args ( $kid ) ; }
    $self -> keys -> select ( where => $qwe, args => [ [ $arg ] ] ) ;
  }

sub find_key { my $self = shift ; ( $self -> find_keys ( @_ ) ) [ 0 ] ; }

# Wotsap
sub get_key
  { OBB::A_is ( 2, scalar @_ ) ;
    my $self  = shift ;
    my $key   = shift ;
    my $kid   = $key -> kid ;
    my $cache = $self -> cache ;
    OBB::TD ( "base get_key %s cache %s", $kid, $cache ) ;
    my $sres  = ( $cache ? $cache -> get_key ( $kid ) : undef ) ;
    OBB::TD ( "base get_key sres %s", $sres ) ;
    $sres = $self -> serv -> get_key ( $key ) unless $sres ;
    $sres ;
  }

sub query
  { OBB::A_is 2, scalar @_ ;
    my $self = shift ;
    my $sql  = shift ;
    OBB::TD ( $sql ) ;
    $self -> dbh -> do ( $sql ) ;
  }

sub get_tups
  { OBB::A_in 2, 3, scalar @_ ;
    my $self = shift ;
    my $sql  = shift ;
    my $args = shift || [ [] ] ;
    my @res  = () ;
    printf "${sql}\n" if $self -> Debug ;
    my $sth  = $self -> dbh -> prepare ( $sql ) or $self -> Xitdb ;
    for my $tup ( @$args )
      { $sth -> execute ( @$tup ) ;
        while ( my $hash = $sth -> fetchrow_hashref )
          { push @res, $hash } ;
      }
    @res ;
  }

sub drop_keys
  { my $self = shift ;
    my @keys = @_ ;
    $self -> keys -> delete ( \@keys ) if @keys ;
    OBB::TV ( "drop keys %s\n", join ',', map $_ -> kid, @keys ) ;
    1 ;
  }

# Wotsap
sub save
  { OBB::A_is 3, scalar @_ ;
    my $self = shift ;
    my $key  = shift ;
    my $sigs = shift ;
    my @indb = $self -> keys -> select
      ( where => 'kid = ?'
      , args  => [ map [ $_ ], keys %$sigs ]
      ) ;
    OBB::TV ( "found keys indb %s of %s\n", scalar @indb, scalar keys %$sigs ) ;
    my %indb = () ; $indb { $_ -> kid } = $_ for @indb ;
    my $adds =
      [ map { $self -> mk_key ( $_ ) }
          grep ! $indb { $_ }, keys %$sigs
      ] ;
    $self -> keys -> save ( $key, @$adds ) ;
    $self -> sigs -> save
      ( $key, [ map [ $_, $sigs -> { $_ -> kid } ], @indb, @$adds ]
      ) if @indb + @$adds ;
    1 ; # to keep test happy
  }

sub signatures
  { my $self = shift ;
    my $key  = shift ;
    my $id   = $key  -> id ;
    my @res  = $self -> sigs -> select ( where => "dst = '$id'" ) ;
    @res ;
  }

sub signed
  { my $self = shift ;
    my $key1 = shift ;
    my $key2 = shift ;
    my $id1  = $key1 -> id ;
    my $id2  = $key2 -> id ;
    my @res  = $self -> sigs -> select1
      ( where => "src = '$id1' and dst = '$id2'" ) ;
    @res ? $res [ 0 ] -> lvl : undef ;
  }

sub get_todo_sigs
  { OBB::A_is 2, scalar @_ ;
    my $self = shift ;
    my $id   = shift -> id ;
    my $NO   = Wotsap::NO ;
    my $sub  = "id in ( SELECT sigs.src FROM sigs WHERE sigs.dst = $id )" ;
    my $redo = "( redo IS NOT NULL AND redo < $^T )" ;
    my $qwe  = "$sub AND done IS NULL AND ( bad = '$NO' or $redo )" ;
    $self -> keys -> select ( cols => 'id', where => $qwe, as_recs => 0 ) ;
  }

sub time0
  { my $self = shift ;
    $self -> keys -> select1
      ( cols => 'min ( done ) as min'
      , where => 'done > 0'
      , as_recs => 0
      ) -> {min} || time ;
  }

sub time1
  { my $self = shift ;
    $self -> keys -> select1
      ( cols => 'max ( done ) as max', as_recs => 0 ) -> {max} || time ;
  }

sub _table_info
  { my $self = shift ;
    my $dbh  = $self -> dbh ;
    my $res  = undef ;
    return $res unless $dbh ;
    my $sth = $dbh -> table_info ( undef, undef, '%', 'TABLE' ) ;
    if ( $sth )
      { $res = $sth -> fetchall_arrayref ; }
    else
      { $self -> Xit ( "_table_info : can't" ) ; }
    $res ;
  }

our %id_signed_by = () ;
sub id_signed_by
  { my $self = shift ;
    my $id   = shift ;
    unless ( exists $id_signed_by { $id } )
      { my $qwe  = "SELECT src FROM sigs WHERE dst = $id" ;
        $id_signed_by { $id } =
          [ map { $_ -> {src} } $self -> get_tups ( $qwe ) ] ;
      }
    @{ $id_signed_by { $id } } ;
  }

our %id_has_signed = () ;
sub id_has_signed
  { my $self = shift ;
    my $id   = shift ;
    unless ( exists $id_has_signed { $id } )
      { my $qwe  = "SELECT dst FROM sigs WHERE src = $id" ;
        $id_has_signed { $id } =
          [ map { $_ -> {dst} } $self -> get_tups ( $qwe ) ] ;
      }
    @{ $id_has_signed { $id } } ;
  }

sub min ($$) { ( $_[0] < $_[1] ) ? $_[0] : $_[1] ; }
sub max ($$) { ( $_[0] > $_[1] ) ? $_[0] : $_[1] ; }

# _xcl_key xcl, id
sub _xcl_key  { $_[0] -> { $_[1] } ++ ; }
sub _key_xcld { exists $_[0] -> { $_[1] } ; }
# _xcl_sig xcl, src, dst
sub _xcl_sig  { $_[0] -> { $_[1] } { $_[2] } ++ ; }
sub _sig_xcld { exists $_[0] -> { $_[1] } { $_[2] } ; }

sub _xpaths
  { my $self = shift ;
    my $from = shift ;
    my $to   = shift ;
    my $excl = shift ;

    my $q0 = [ $from ] ;
    my $q1 = [ $to ] ;
    my %depth = ( $from => 1, $to => -1 ) ;
    my $depth ;
    my $mm ;
    my $mm_depth ;
    my $item ;

    printf "exclude keys %d\n", scalar keys %$excl if $self -> Verbose ;

    while ( ! defined $mm )
      { # if either queue is empty, there is no path
        # else process the shortest queue
        my %qtmp = () ;

        printf "q0 %3d q1 %3d dpths %3d\n"
          , scalar @$q0, scalar @$q1, scalar keys %depth
            if $self -> Verbose ;

        unless ( @$q0 and @$q1 )
          { return undef ; }
        elsif ( @$q0 < @$q1 )
          { while ( @$q0 )
              { my $item = shift @$q0 ;
                my $depth = $depth { $item } + 1 ;
                for my $next ( $self -> id_has_signed ( $item ) )
                  { next if _key_xcld $excl, $next ;
                    unless ( defined $depth { $next } )
                      { $depth { $next } = $depth ; $qtmp { $next } ++ ; }
                    elsif ( $depth { $next } < 0 )
                      { $mm = $next ; $mm_depth = $depth ; last ; }
                  }
              }

            if ( defined $mm ) { last ; } else { $q0 = [ keys %qtmp ] ; }
          }
        else
          { while ( @$q1 )
              { my $item = shift @$q1 ;
                my $depth = $depth { $item } - 1 ;
                for my $next ( $self -> id_signed_by ( $item ) )
                  { next if _key_xcld $excl, $next ;
                    unless ( defined $depth { $next } )
                      { $depth { $next } = $depth ; $qtmp { $next } ++ ; }
                    elsif ( $depth { $next } > 0 )
                      { $mm = $next ; $mm_depth = $depth ; last ; }
                  }
              }

            if ( defined $mm ) { last ; } else { $q1 = [ keys %qtmp ] ; }
          }
      }

    $depth = max $mm_depth, $depth { $mm } ;

    my @res0 = () ;
    $item = $mm ;
    while ( $item != $from )
      { $depth -- ;
        my $found = 0 ;
        for my $next ( $self -> id_signed_by ( $item ) )
          { if ( defined $depth { $next } and $depth { $next } == $depth )
              { unshift @res0, $next ; $item = $next ; $found = 1 ; last ; }
          }
        die "up: no signer for depth $depth" unless $found ;
      }

    $depth = min $mm_depth, $depth { $mm } ;

    my @res1 = () ;
    $item = $mm ;
    while ( $item != $to )
      { $depth ++ ;
        my $found = 0 ;
        for my $next ( $self -> id_has_signed ( $item ) )
          { if ( defined $depth { $next } and $depth { $next } == $depth )
              { push @res1, $next ; $item = $next ; $found = 1 ; last ; }
          }
        die "down: no signer for depth $depth" unless $found ;
      }

    return [ @res0, $mm, @res1 ] ;
  }

sub get_ids
  { my $self = shift ;
    map $self -> keys -> get ( $_ ), @_ ;
  }

sub xpaths
  { my $self = shift ;
    my $from = shift ;
    my $to   = shift ;
    my $max  = shift || MAX_PATHS ;
    my $res  = [] ;
    my $excl = {} ;

    return undef unless defined $from and defined $to ;

    my $a = $from -> id ;
    my $b = $to   -> id ;

    if ( $a == $b or $self -> sigs -> get ( $a, $b ) )
      { push @$res, [ $self -> get_ids ( $a, $b ) ] ; }
    else
      { my $path ;
        while ( @$res < $max and $path = $self -> _xpaths ( $a, $b, $excl ) )
          { # map id's to keys
            push @$res, [ $self -> get_ids ( @$path ) ] ;
            # exclude the interior
            shift @$path ; pop @$path ;
            _xcl_key $excl, $_ for @$path ;
          }
      }
    $res ;
  }

###################################################################
# Tab defs
###################################################################
package Wotsap::Tab ;
use base 'OBB' ; __PACKAGE__ -> mk_getset ( qw(base name cols) ) ;
sub Defs { ( cols => [] ) ; }

sub row_pack { 'Wotsap::Rec' ; }

sub WITH
  { my $tup = shift ;
    join ',', map { defined $_ ? $_ : '<undef>' } @$tup ;
  }

our %KWDS ;
our @KWDS = qw(from where group_by having order_by limit) ;
@KWDS { @KWDS } = map { my $x = $_ ; $x =~ s/_/ / ; uc $x ; } @KWDS ;

sub sql_select
  { OBB::A_ge 0, scalar @_ ;
    my %opts = ( cols => '', @_ ) ;
    my $cols = $opts{cols} || '*' ;
    sprintf "SELECT %s%s%s%s%s%s%s"
      , $cols, map { $opts{$_} ? " $KWDS{$_} $opts{$_}" : '' ; } @KWDS ;
  }

sub select
  { OBB::A_ge 1, scalar @_ ;
    my $self = shift ;
    my %opts =
      ( from    => ( ref ( $self ) ? $self -> name : 'no_name' )
      , args    => [ [] ]
      , as_recs => 1
      , @_
      ) ;
    my $dbh  = $self -> base -> dbh ;
    my $res  = [] ;
    my $sql  = sql_select ( %opts ) ;
    my $args = $opts { args } ;
    print "$sql ;\n" if $self -> Debug ;
    my $sth  = $dbh -> prepare ( $sql ) or $self -> Xit ( $dbh -> errstr ) ;
    for my $tup ( @$args )
      { printf "WITH [%s]\n", WITH $tup if $self -> Debug ;
        $sth -> execute ( @$tup ) ;
        while ( my $hash = $sth -> fetchrow_hashref )
          { push @$res, $hash } ;
      }
    @$res = map $self -> Rec ( %$_ ), @$res if $opts { as_recs } ;
    @$res ;
  }

sub select1
  { my $self = shift ; ( $self -> select ( @_, limit => 1 ) ) [ 0 ] ; }

sub count
  { OBB::A_ge 1, scalar @_ ;
    my $self = shift ;
    ( $self -> select1 ( @_, cols => 'count(*) as _count_', as_recs => 0 ) )
      [ 0 ] -> { _count_ } ;
  }

sub max
  { OBB::A_ge 2, scalar @_ ;
    my $self = shift ;
    my $col  = shift ;
    ( $self -> select1 ( @_, cols => "MAX($col) as _max_", as_recs => 0 ) )
      [ 0 ] -> { _max_ } ;
  }

sub IUD
  { OBB::A_in 2, 3, scalar @_ ;
    my $self = shift ;
    my $sql  = shift ;
    my $tups = shift || [ [] ] ;
    my $dbh  = $self -> base -> dbh ;
    my $res  = [] ;
    my $ins  = $sql =~ /^insert/i ;
    printf "%s ;%s", $sql, ( @$tups != 1 ? "\n" : ' ' ) if $self -> Debug ;
    $dbh -> begin_work or $self -> Xit ( $dbh -> errstr ) ;
    my $sth  = $dbh -> prepare ( $sql ) or $self -> Xit ( $dbh -> errstr ) ;
    for my $tup ( @$tups )
      { printf "WITH [%s]\n", WITH $tup if $self -> Debug ;
        my $rv  = $sth -> execute ( @$tup ) ;
        if ( $ins )
          { my $id  = $dbh -> last_insert_id ( '', '', '', '' ) ;
            push @$res, $id ;
          }
        my $err = $dbh -> errstr ;
        unless ( $rv ) { $dbh -> rollback ; $self -> Xit ( $err ) ; }
      }
    $dbh -> commit ;
    ( $ins ? $res : $sth -> rows ) ;
  }

sub sql_insert
  { my %opts = ( cols => [] , into => '' , @_ ) ;
    my $cols = $opts{cols} ;
    my $nams = join ',', @$cols ;
    my $phds = join ',', map '?', @$cols ;
    sprintf "INSERT INTO %s (%s) VALUES (%s)"
      , $opts {into}, $nams, $phds ;
  }

sub insert
  { my $self = shift ;
    my %opts =
      ( cols => []
      , into => ( ref ( $self ) ? $self -> name : 'no_name' )
      , args => [ [] ]
      , @_
      ) ;
    $self -> IUD ( sql_insert ( %opts ), $opts { args } ) ;
  }

sub sql_update
  { my %opts = ( tabl => '', cols => [], where => '1', @_ ) ;
    my $cols = $opts{cols} ;
    my $phds = join ',', map "$_ = ?", @$cols ;
    sprintf "UPDATE %s SET %s WHERE %s"
      , $opts {tabl}, $phds, $opts {where} ;
  }

sub update
  { my $self = shift ;
    my %opts =
      ( cols => []
      , tabl => ( ref ( $self ) ? $self -> name : 'no_name' )
      , args => [ [] ]
      , @_
      ) ;
    $self -> IUD ( sql_update ( %opts ), $opts { args } ) ;
  }

sub Rec
  { my $self = shift ;
    my $pack = $self -> row_pack ;
    $pack -> Make ( @_, tabl => $self ) ;
  }

sub as_tup { my $obj = shift ; [ map { $obj -> $_ } @_ ] ; }

sub _column_info
  { my $self = shift ;
    my $name = $self -> name ;
    $self -> Xit ( 'no base' ) unless $self -> base ;
    my $dbh  = $self -> base -> dbh  ;
    my $res  = undef ;
    return $res unless $dbh and $name ;
    my $sth = $dbh -> column_info ( undef, undef, $name, '%' ) ;
    if ( $sth )
      { $res = $sth -> fetchall_arrayref ; }
    else
      { $self -> Xit ( "_column_info : can't" ) ; }
    $res ;
  }

sub _cols
  { OBB::A_is 1, scalar @_ ;
    my $self = shift  ;
    my $name = $self -> name ;
    my $info = $self -> _column_info ( $name ) ;
    my $res  = undef ;
    if ( $info )
      { $res = [ sort map { $_ -> [3] ; } @$info ] ; }
    else
      { $self -> Xit ( "_column_info : can't" ) ; }
    $res ;
  }

###################################################################
package Wotsap::Meta ;
use base qw(Wotsap::Tab) ; __PACKAGE__ -> mk_getset ( qw() ) ;

use constant COLS => qw(version db_type kserver prg_gpg rootkid) ;
use constant PRG_GPG => '/usr/bin/gpg' ;

my %DEFS =
  ( prg_gpg => PRG_GPG
  , rootkid => Wotsap::DEFROOT
  ) ;

sub row_pack { 'Wotsap::Met' ; }

sub mk_col
  { my $self = shift ;
    my $col  = shift ;
    my $have = $self -> _cols ;
    unless ( grep $_ eq $col, @$have )
      { my $def  = $DEFS { $col } || '' ;
        my $sql  = sprintf 'ALTER TABLE %s ADD COLUMN %s text %s'
          , $self -> name
          , $col
          , "DEFAULT '$def'"
          ;
        $self -> base -> query ( $sql ) ;
      }
    push @{ $self -> cols }, $col ;
    for my $sub ( 'get_', 'set_', '' )
      { eval sprintf 'sub %s%s { %sxxx ( @_, "%s" ) ; }'
          , $sub, $col, $sub, $col unless $self -> can ( "$sub$col" ) ;
      }
  }

sub mk_cols
  { my $self = shift ; for my $col ( COLS ) { $self -> mk_col ( $col ) ; } }

sub get_xxx
  { OBB::A_is 2, scalar @_ ;
    my $self = shift ;
    my $key  = pop ;
    my $verb = $self -> Verbosity ( 'Silent' ) ;
    my $res  = $self -> select1 -> $key ;
    $self -> Verbosity ( $verb ) ;
    $res ;
  }

sub set_xxx
  { OBB::A_is 3, scalar @_ ;
    my $self = shift ;
    my $key  = pop ;
    $self -> update ( cols => [ $key ], args => [ [ @_ ] ] ) ;
  }

sub xxx
  { OBB::A_in 2, 3, scalar @_ ;
    my $self = shift ;
    my $key  = pop ;
    $self -> set_xxx ( @_, $key ) if @_ ;
    $self -> get_xxx ( $key ) ;
  }

##################################################################
package Wotsap::Keys ;
use base qw(Wotsap::Tab) ; __PACKAGE__ -> mk_getset ( qw() ) ;
use constant FIELDS_INSERT => qw(kid sum bad uid redo) ;
use constant FIELDS_UPDATE => qw(sum bad uid redo) ;
use constant FIELDS_DELETE => qw(id) ;

sub row_pack { 'Wotsap::Key' ; }
sub as_tup { Wotsap::Tab::as_tup @_ ; }

sub get
  { my $self = shift ;
    my $id   = shift ;
    $self -> select1 ( where => 'id = ?', args => [ [ $id ] ] ) ;
  }

# Wotsap::Keys ;
sub insert
  { my $self = shift ;
    my $keys = shift ;
    my $cols = join ',', FIELDS_INSERT ;
    my $plhs = join ',', map '?', FIELDS_INSERT ;
    my $sql  = "INSERT into keys ( $cols ) VALUES ( $plhs )" ;
    my $tups = [ map { as_tup $_, FIELDS_INSERT ; } @$keys ] ;
    my $ids  = $self -> IUD ( $sql, $tups ) ;
    my $res  = @$ids ;
    $self -> Xit ( "insert_keys #tups [%s] != #ids [%s]", scalar @$keys, $res )
      if $res != @$keys ;
    for my $key ( @$keys ) { $key -> id ( shift @$ids ) ; }
    $res ;
  }

# Wotsap::Keys ;
sub update
  { my $self = shift ;
    my $keys = shift ;
    my $cols = join ', ', map "$_ = ?", FIELDS_UPDATE ;
    my $sql  = "UPDATE keys SET $cols WHERE id = ?" ;
    my $tups = [ map { as_tup $_, FIELDS_UPDATE, 'id' ; }
      grep defined $_ -> id, @$keys ] ;
    $self -> IUD ( $sql, $tups ) ;
  }

sub set_redo
  { OBB::A_is 2, scalar @_ ;
    my $self = shift ;
    my $kid  = shift ;
    my $redo = $^T + Wotsap::REDO_INCR ;
    my $sql  = "UPDATE keys SET redo = ? WHERE kid = ?" ;
    $self -> IUD ( $sql, [ [ $redo, $kid ] ] ) ;
  }

# Wotsap::Keys ;
sub delete
  { my $self = shift ;
    my $keys = shift ;
    my $sql  = 'DELETE from keys where id = ?' ;
    my $tups = [ map { [ $_ -> id ] } grep defined $_ -> id, @$keys ] ;
    $self -> IUD ( $sql, $tups ) if @$tups ;
  }

# Wotsap::Keys ;
sub save
  { my $self = shift ;
    my @keys = @_ ;
    my $adds = [] ;
    my $upds = [] ;
    for my $key ( @keys )
      { my $kid = $key -> kid ;
        $key -> sum ( Wotsap::SUM_BAD . $kid ) if $key -> bad eq 'key_sid' ;
        $key -> sum ( Wotsap::SUM_DEF . $kid ) unless $key -> sum ;
        push @{ defined $key -> id ? $upds : $adds }, $key ;
      }
    my $ads = $self -> insert ( $adds ) if @$adds ;
    my $ups = $self -> update ( $upds ) if @$upds ;
    $ads ||= 0 ; $ups ||= 0 ;
    $self -> Xit ( "save keys #tups [%d] != ads [%d] + ups [%d]"
      , scalar @keys, $ads, $ups ) if @keys != $ads + $ups ;
    OBB::TV
      ( "save keys %s adds %s upds %s"
      , scalar @keys, scalar @$adds, scalar @$upds
      ) ;
    OBB::TD ( "save keys %s\n", join ',', map { $_ -> kid } @keys ) ;
    $ads + $ups ;
  }

sub mark_as
  { OBB::A_is 3, scalar @_ ;
    my $self = shift ;
    my $done = shift ;
    my $ids  = shift ;
    my $qwe  = "UPDATE keys SET done = ? WHERE id = ?" ;
    $self -> IUD ( $qwe, [ map [ $done, $_ ], @$ids ] ) ;
  }

sub mark_as_init
  { my $self = shift ; my $ids  = shift ; $self -> mark_as ( undef, $ids ) ; }
sub mark_as_todo
  { my $self = shift ; my $ids  = shift ; $self -> mark_as ( 0,     $ids ) ; }
sub mark_as_done
  { my $self = shift ; my $ids  = shift ; $self -> mark_as ( time,  $ids ) ; }

sub reset_all_sums
  { my $self = shift ;
    my $wher = shift ;
    my $init = Wotsap::SUM_DEF ;
    my $qwe  = "UPDATE keys SET sum = '$init' || kid where $wher" ;
    $self -> base -> query ( $qwe ) ;
  }

sub reset_all_bads
  { my $self = shift ;
    my $wher = shift ;
    my $qwe  = "UPDATE keys SET bad = '' where $wher" ;
    $self -> base -> query ( $qwe ) ;
  }

###################################################################
package Wotsap::Sigs ;
use base qw(Wotsap::Tab) ; __PACKAGE__ -> mk_getset ( qw() ) ;
use constant FIELDS_INSERT => qw(src dst lvl) ;
use constant FIELDS_UPDATE => qw(lvl src dst) ;
use constant FIELDS_DELETE => qw(src dst) ;

sub row_pack { 'Wotsap::Sig' ; }
sub as_tup { Wotsap::Tab::as_tup @_ ; }

sub find
  { OBB::A_is 2, scalar @_ ;
    my $self = shift ;
    my $kid  = Wotsap::as_kid shift ;
    my $res  = {} ;
    my @itms = $self -> select
      ( cols    => 'src,lvl'
      , where   => 'dst = ?'
      , args    => [ [ $kid ] ]
      , as_recs => 0
      ) ;
    for my $hash ( @itms )
      { $res -> { $hash -> {src} } = $hash -> {lvl} ; }
    $res ;
  }

sub insert
  { OBB::A_is 2, scalar @_ ;
    my $self = shift ;
    my $sigs = shift ;
    my $tups = [ map { as_tup $_, FIELDS_INSERT ; } @$sigs ] ;
    my $sql  = 'INSERT into sigs ( src, dst, lvl ) VALUES ( ?, ?, ? )' ;
    $self -> IUD ( $sql, $tups ) ;
  }

sub update
  { OBB::A_is 2, scalar @_ ;
    my $self = shift ;
    my $sigs = shift ;
    my $tups = [ map { as_tup $_, FIELDS_UPDATE ; } @$sigs ] ;
    my $sql  = 'UPDATE sigs SET lvl = ? where src = ? and dst = ?' ;
    $self -> IUD ( $sql, $tups ) ;
  }

sub delete
  { OBB::A_is 2, scalar @_ ;
    my $self = shift ;
    my $sigs = shift ;
    my $tups = [ map { as_tup $_, FIELDS_DELETE ; } @$sigs ] ;
    my $sql  = 'DELETE from sigs where src = ? and dst = ?' ;
    $self -> IUD ( $sql, $tups ) ;
  }

sub save
  { OBB::A_is 3, scalar @_ ;
    my $self = shift ;
    my $dst  = shift ; # $dst -> id is 'dst' for all sigs
    my $list = shift ; # [ [ src => lvl ], ... ]
    my $dbh  = $self -> base -> dbh ;
    my $adds = [] ;
    my $upds = [] ;
    my $dels = [] ;
    # make a Sig for each tuple in @$list ; %sigs = ( src => sig, ... )
    my @sigs = map $self -> Rec
      ( src => $_ -> [ 0 ] -> id
      , dst => $dst -> id
      , lvl => $_ -> [ 1 ]
      ), @$list ;
    my %sigs ; $sigs { $_ -> src } = $_ for @sigs ;

    # fetch sigs of $dst ; %indb = ( src => sig, ... )
    my @indb = $self -> select
      ( where => 'dst = ?'
      , args  => [ [ $dst -> id ] ]
      ) ;
    my %indb ; $indb { $_ -> src } = $_ for @indb ;
    printf "found sigs %s : indb %d of %d\n"
      , $dst -> kid, scalar @indb, scalar @$list
        if $self -> Verbose ;

    for my $src ( keys %sigs )
      { my $sig = $sigs { $src } ;
        if ( ! exists $indb { $src } )
          { push @$adds, $sig ; }
        elsif ( $indb { $src } -> lvl != $sig -> lvl )
          { push @$upds, $sig ; }
      }

    for my $src ( keys %indb )
      { my $sig = $indb { $src } ;
        if ( ! exists $sigs { $src } ) { push @$dels, $sig; }
      }

    printf "save sigs %s del %d upd %d add %d\n"
      , $dst -> kid, scalar @$dels, scalar @$upds, scalar @$adds
        if $self -> Verbose ;
    $self -> insert ( $adds ) if scalar @$adds ;
    $self -> update ( $upds ) if scalar @$upds ;
    $self -> delete ( $dels ) if scalar @$dels ;
    scalar @$adds + scalar @$upds + scalar @$dels ;
  }

sub get
  { my $self = shift ;
    my $src  = shift ;
    my $dst  = shift ;
    $self -> select1
      ( where => 'src = ? and dst = ?', args => [ [ $src, $dst ] ] ) ;
  }

###################################################################
# Rec defs
###################################################################
package Wotsap::Rec ;
use base 'OBB' ; __PACKAGE__ -> mk_getset ( qw(tabl) ) ;

###################################################################
package Wotsap::Met ;
__PACKAGE__ -> mk_getset ( Wotsap::Meta -> COLS ) ;
use base qw(Wotsap::Rec) ;

###################################################################
package Wotsap::Key ;
__PACKAGE__ -> mk_getset ( qw(id kid uid sum bad wid done redo) ) ;
use base qw(Wotsap::Rec) ;

use constant
  { TXT       => 1
  , NO        => Wotsap::NO
  , NO_UID    => 'no uid'
  } ;

sub Init
  { my $self = shift ;
    my %opts = ( @_ ) ;
    $self -> OBB::Init ( %opts ) ;
    $self ;
  }

sub Defs { ( id => undef, sum => '', bad => NO, uid => '' ) ; }

sub signatures
  { my $self = shift ;
    $self -> tabl -> base -> sigs -> select
      ( where => 'dst = ?', args => [ [ $self -> id ] ] ) ;
  }

sub signed_by
  { my $self = shift ;
    my $sub  = "SELECT sigs.src FROM sigs WHERE sigs.dst = ?" ;
    $self -> tabl -> base -> keys -> select
      ( where => "id in ( $sub )"
      , order_by => 'kid'
      , args => [ [ $self -> id ] ]
      ) ;
  }

sub has_signed
  { my $self = shift ;
    my $sub  = "SELECT sigs.dst FROM sigs WHERE sigs.src = ?" ;
    $self -> tabl -> base -> keys -> select
      ( where => "id in ( $sub )"
      , order_by => 'kid'
      , args => [ [ $self -> id ] ]
      ) ;
  }

sub lines { my $self = shift ; join '', @{ $self -> dmp } ; }
sub is_ok { my $self = shift ; ! $self -> bad ; }
sub def_sum { my $self = shift ; Wotsap::SUM_DEF . $self -> kid ; }

sub mark_as
  { my $self = shift ;
    my $done = shift ;
    $self -> done ( $done ) ;
    $self -> tabl -> mark_as ( $done, [ $self -> id ] ) ;
    $self ;
  }
sub mark_as_init { my $self = shift ; $self -> mark_as ( undef ) ; }
sub mark_as_todo { my $self = shift ; $self -> mark_as ( 0     ) ; }
sub mark_as_done { my $self = shift ; $self -> mark_as ( time  ) ; }

# package Wotsap::Key ;
sub drop_sigs
  { my $self = shift ;
    my $dir  = shift ;
    my $id   = $self -> id ;
    $self -> tabl -> base -> query ( "DELETE FROM sigs where $dir = $id" ) ;
    $self ;
  }

sub drop_sigs_on_me { my $self = shift ; $self -> drop_sigs ( 'dst' ) ; }
sub drop_sigs_by_me { my $self = shift ; $self -> drop_sigs ( 'src' ) ; }

# package Wotsap::Key ;
sub set_for_todo
  { my $self = shift ;
    my $kid  = $self -> kid ;
    $self -> sum ( Wotsap::SUM_DEF . $kid ) ;
    $self -> bad ( '' ) ;
    $self -> tabl -> save ( $self ) ;
    $self -> drop_sigs_on_me ;
    $self -> mark_as_todo ;
    $self ;
  }

# package Wotsap::Key ;
sub save_upd
  { OBB::A_is ( 4, scalar @_ ) ;
    my $self = shift ;
    my $base = shift ;
    my $sum  = shift ;
    my $sigs = shift ;
    $self -> sum ( $sum ) ;
    $base -> save ( $self, $sigs ) ;
    1 ;
  }

# refresh
# an ok key expires after it's expdate
# a sig on an ok key expires after it's expdate
# a expired key can become ok ; key has to change
# key.redo : first date in the future of
#   { key.expdate
#   , key.sigs.expdate
#   , ( key.bad == 'expire' ? $^T + 4 weeks : undef )
#   }

sub refresh
  { OBB::A_is ( 2, scalar @_ ) ;
    my $self = shift ;
    my $base = shift ;
    printf "refresh key %s\n", $self -> kid if $self -> Debug ;
    my $sres = $base -> get_key ( $self ) ;
    my $serv_sum = $sres -> sum ;
    my $self_sum = $self -> sum ;
    my $upd = '' ;
    my $redo = ( $self -> redo and $self -> redo < $^T ) ;

    if ( $sres -> err )
      { $upd = undef ; }
    elsif ( $sres -> empty ) # no block
      { # if new or initial key then update
        if ( ! $self_sum or $self_sum eq $self -> def_sum )
          { $self -> bad ( NO ) ;
            $self -> save_upd ( $base, $serv_sum, {} ) ;
            $upd = 'emp' ;
          }
        # else no change
      }
    elsif ( $serv_sum eq $self_sum and $redo and $self -> bad eq 'expired' )
      { $base -> keys -> set_redo ( $self -> kid ) ;
        $upd = 'REDO' ;
      }
    elsif ( $serv_sum ne $self_sum or $redo )
      { my $sigs = {} ;
        OBB::TD ( "sum serv %s self %s", $serv_sum, $self_sum ) ;
        my $path = $self -> save_block ( $base, $sres ) ;
        $sres -> pth ( $path ) ;
        $base -> cache -> save ( $path, $self -> kid )
          if $base -> cache and not $sres -> hit ;
        unless ( $self -> mk_import ( $base, $sres ) )
          { $self -> bad ( 'gpg_imp' ) ; }
        elsif ( $self -> mk_dump ( $base, $sres ) )
          { $sigs = $self -> mk_sigs_uid_bad ( $sres -> dmp ) ; }
        else
          { $self -> bad ( 'gpg_dmp' ) ; }

        $self -> save_upd ( $base, $serv_sum, $sigs ) ;
        $upd =
          ( $redo
          ? 'redo'
          : ( $self_sum eq $self -> def_sum ? 'new' : 'upd' )
          ) ;
      }
    elsif ( $base -> cache and not $sres -> hit )
      { unless ( $base -> cache -> touch ( $self -> kid ) )
          { my $path = $self -> save_block ( $base, $sres ) ;
            $sres -> pth ( $path ) ;
            $base -> cache -> save ( $path, $self -> kid )
          }
      }

    $sres -> upd ( $upd ) ;
    $sres ;
  }

sub save_block
  { OBB::A_is ( 3, scalar @_ ) ;
    my $self = shift ;
    my $base = shift ;
    my $sres = shift ;
    my $path = $base -> path4bloc ;
    my $bloc = $sres -> blc ;
    unlink $path ;
    open TMP, '>', $path or Xit ( "can't write $path ($!)" ) ;
    print TMP $bloc ;
    close TMP ;
    $path ;
  }

sub mk_import
  { OBB::A_is ( 3, scalar @_ ) ;
    my $self = shift ;
    my $base = shift ;
    my $sres = shift ;
    my $sink = $base -> p_sink ;
    my $path = $sres -> pth ;

    unlink "$sink/pubring.gpg" ;
    unlink "$sink/pubring.gpg~" ;

    my @CMD  =
      ( $base -> meta -> prg_gpg
      , qw(-v --homedir), $sink
      , qw(--no-default-keyring --no-auto-check-trustdb --batch)
      , qw(--import), $path
      ) ;

    print "mk_import path [$path]\n" if $self -> Verbose ;
    printf "@CMD\n" if $self -> Debug ;
    my $pid = open CMD, "-|" ;
    unless ( defined $pid )
      { die "can't popen - ($!)" ; }
    elsif ( ! $pid )
      { # child
        open STDERR, '>/dev/null' ;
        unless ( exec @CMD )
          { print "exec [@ARGV] failed ; will kill myself\n" ;
            kill 9, $$ or die "gone\n" ;
          }
      }
    print <CMD> ;
    # return success iff GPG runs clean ;
    my $clo = close CMD ;
    my $sig = $? & 127 ;
    my $xit = $? >> 8 ; # exit status
    ! $xit ;
  }

sub by_time
  { my $aa = ( split /:/, $a ) [ 5 ] || 0 ;
    my $bb = ( split /:/, $b ) [ 5 ] || 0 ;
    $aa <=> $bb ;
  }

sub mk_dump
  { OBB::A_in ( 3, 4, scalar @_ ) ;
    my $self = shift ;
    my $base = shift ;
    my $sres = shift ;
    my $FILE = shift ; # optional ; dump from file
    my @CMD  =
      ( $base -> meta -> prg_gpg
      , qw(-v --homedir), $base -> p_sink
      , qw(--no-default-keyring --no-auto-check-trustdb --batch)
      , qw(--no-expensive-trust-checks --with-colons --fixed-list-mode)
      , qw(--with-fingerprint --check-sigs)
      ) ;

    if ( $FILE ) { pop @CMD ; push @CMD, $FILE ; }

    printf "@CMD\n" if $self -> Debug ;
    my $pid = open CMD, "-|" ;
    unless ( defined $pid )
      { die "can't popen - ($!)" ; }
    elsif ( ! $pid )
      { # child
        open STDERR, '>/dev/null' ;
        unless ( exec @CMD )
          { print "exec [@ARGV] failed ; will kill myself\n" ;
            kill 9, $$ or die "gone\n" ;
          }
      }

    # time-order the sigs
    my @tmp = () ;
    my @dmp = () ;
    while ( <CMD> )
      { last if /^(sub|uat):/ ;
        if ( /^(sig|rev):/ )
          { push @tmp, $_ ; }
        else
          { if ( @tmp ) { push @dmp, sort by_time @tmp ; @tmp = () ; }
            push @dmp, $_ ;
          }
      }
    push @dmp, sort by_time @tmp ;
    while ( <CMD> ) { 1 ; }

#   $sres -> dmp ( [ <CMD> ] ) ;
    $sres -> dmp ( [ @dmp ] ) ;
    # return success iff GPG runs clean ;
    my $clo = close CMD ;
    my $sig = $? & 127 ;
    my $xit = $? >> 8 ; # exit status
    # die if can't exec
    # $self -> Xit ( "sig[$sig] can't close [@CMD]" ) if ! $clo and $sig ;
    ! $xit ;
  }

sub mk_sigs_uid_bad
  { OBB::A_in ( 2, 3, scalar @_ ) ;
    my $self = shift ;
    my $dmp  = shift ;
    my @tab  = () ;
    my $kid  = undef ;
    my $bad  = NO ;
    my $exps = {} ; # expiration dates for used sigs
    my $sigs = undef ; # sigs on 'current' pub or uid
    my %uids = () ; # uid for $sigs
    my $fuid ;
    printf "mk_stuff kid [%s]\n", $self->kid if $self -> Verbose ;
    my $fpr  = undef ;
    my $pub  = 0 ; # incremented by 'pub' ; should not be > 1
    for my $line ( @$dmp )
      { chomp $line ;
        print "$line\n" if $self -> Debug ;
        my @rec = split /:/, $line ;
        my $tag = $rec [ 0 ] ;

        if ( $tag eq 'sub' )
          { last ; }
        elsif ( $tag eq 'pub' )
          { my $val = $rec [ 1 ] ;
            my $exp = $rec [ 6 ] ;
            $kid = lc $rec [ 4 ] ;
            $pub ++ ;

            if ( $self -> kid ne $kid )
              { $bad = 'key_sid' ; }
            elsif ( $val eq 'r' )
              { $bad = 'revoked' ; }
            elsif ( $val eq 'i' )
              { $bad = 'invalid' ; }
            elsif ( $val eq 'n' )
              { $bad = '! valid' ; }
            elsif ( $val eq 'e' or ( $exp and $exp < $^T ) )
              { $bad = 'expired' ; }
            elsif ( $exp )
              { $exps -> { $exp } ++ ; }

            OBB::TD ( "found pub %s bad %s", $kid, $bad ) ;
          }
        elsif ( $tag eq 'uid' )
          { my $uid  = $rec [ 9 ] ;
            push @tab, $sigs if scalar %uids ;
            $sigs = {} ;
            $uids { $sigs } = $uid ;
            $fuid = $uid unless defined $fuid ;
            OBB::TD ( "found uid %s", $uid ) ;
          }
        elsif ( $tag eq 'fpr' )
          { $fpr = lc $rec [ 9 ] ;
            unless ( length $fpr >= length $kid )
              { $bad = 'fpr_len' ; }
            OBB::TD ( "found fpr %s\n", $fpr ) ;
#           elsif ( $kid ne substr $fpr, - length $kid )
#             { $bad = 'fpr_lid' ; }
          }
        elsif ( $tag eq 'sig' )
          { my $sig = lc $rec [ 4 ] ;
            my $tim = $rec [ 5 ] ;
            my $exp = $rec [ 6 ] ;
            my $cls = $rec [ 10 ] ;
            if ( ! $tim or $tim !~ /^\d+$/ )
              { OBB::TD ( "sig %s skip ; bad time %s", $sig, $tim ) ; }
            elsif ( $exp and $exp < $^T )
              { # ignore ; delete $sigs -> { $sig } ;
                OBB::TD ( "sig %s skip ; expired", $sig ) ;
              }
            elsif ( ! defined $sigs )
              { OBB::TV ( "sig %s skip ; bad pub or uid", $sig ) ; }
            elsif ( ! defined $cls or $cls !~ /^.([0-9a-f])/i )
              { OBB::TV ( "bad cls %s %s", $cls, $line ) ; }
            else
              { my $lvl = hex $1 ;
                if ( $lvl <= 3 )
                  { my $max = $sigs -> { $sig } || 0 ;
                    $max = $lvl if $lvl > $max ;
                    $sigs -> { $sig } = $max ;
                    $exps -> { $exp } ++ if $exp ;
                    OBB::TD ( "sig %s %s used exp %s", $sig, $max, $exp ) ;
                  }
              }
          }
        elsif ( $tag eq 'rev' )
          { my $sig = lc $rec [ 4 ] ;
            my $slf = $sig eq $kid ? 'self' : '' ;
            OBB::TD ( "%ssig %s was revoked", $slf, $sig ) ;
            unless ( defined $sigs )
              { OBB::TD ( "rev %s skip ; bad pub or uid", $sig ) ; }
            else
              { delete $sigs -> { $sig } ; }
          }
      }
    push @tab, $sigs ;
    OBB::TD ( 'tab %s', scalar @tab ) ;
    my $res = {} ;
    my $uid ;
    my $prim = $tab [ 0 ] ;
    unless ( defined $prim )
      { $uid = $fuid ;
        $bad = 'no_prim' ;
      }
    else
      { $uid = $uids { $prim } ;
        for my $sig ( keys %$prim ) { $prim -> { $sig } += 4 ; }
        for $sigs ( @tab )
          { next  unless defined $sigs ;
            # use if uid is self-signed
#           if ( exists $sigs -> { $kid } )
#           accept all valid sigs
            if ( 1 )
              { delete $sigs -> { $kid } ;
                for my $sig ( keys %$sigs )
                  { my $lvl = $sigs -> { $sig } ;
                    my $cur = $res -> { $sig } ;
                    $res -> { $sig } = $lvl
                      if ! defined $cur or $cur < $lvl ;
                  }
              }
            else
              { OBB::TD
                  ( "uid not selfsigned %s ; ignored sigs %s"
                  , $uids { $sigs } , scalar keys %$sigs
                  ) ;
              }
          }
      }
    # determine redo
    my $redo = undef ;
    if ( $bad eq NO )
      { for my $time ( sort { $a <=> $b } keys %$exps )
          { if ( $time > $^T ) { $redo = $time ; last ; } }
      }
    elsif ( $bad eq 'expired' )
      { $redo = $^T + Wotsap::REDO_INCR ; }
    $self -> redo ( $redo ) ;
    $self -> uid ( $uid || NO_UID ) ;
    $self -> bad ( $bad ) ;
    $bad ? {} : $res ;
  }

sub jdmp
  { my $self = shift ;
      { kid => $self -> kid
      , uid => $self -> uid
      }
  }

###################################################################
package Wotsap::Sig ;
__PACKAGE__ -> mk_getset ( qw(src dst lvl) ) ;
use base qw(Wotsap::Rec) ;

# can't get a dbh via Wotsap::Keys
# sub signer { my $self = shift ; Wotsap::Keys -> get ( $self -> src ) ; }
# sub signee { my $self = shift ; Wotsap::Keys -> get ( $self -> dst ) ; }

###################################################################
package Wotsap::Rec::Sigs ;
use base qw(Wotsap::Rec) ; __PACKAGE__ -> mk_getset ( qw() ) ;

###################################################################
package Wotsap::Rec::Sset ;
use base qw(Wotsap::Rec) ; __PACKAGE__ -> mk_getset ( qw() ) ;

###################################################################
package Wotsap::Result ;
use base 'OBB' ;
__PACKAGE__ -> mk_getset ( qw(kid blc pth dmp timeout upd hit err) ) ;
sub Defs 
  { ( kid => '', blc => '', timeout => 0, upd => undef, hit => 0, err => ''
    ) ;
  }
sub empty { my $self = shift ; $self -> blc eq '' ; }

# to change, fix sub sum ; run resum ; then copy sub sum -> sum_old
sub sum
  { my $self = shift ;
    my $kid  = $self -> kid ;
    my $blc  = $self -> blc ;
    $blc =~ s/Comment: .*\n//o ;
    $blc =~ s/Version: .*\n//o ;
    ( $self -> timeout
    ? undef
    : ( $blc
      ? Digest::MD5 -> new -> add ( $blc ) -> hexdigest
      : Wotsap::SUM_NOB . $kid
      )
    ) ;
  }

sub sum_old
  { my $self = shift ;
    my $kid  = $self -> kid ;
    my $blc  = $self -> blc ;
    $blc =~ s/Comment: .*\n//o ;
    $blc =~ s/Version: .*\n//o ;
    ( $self -> timeout
    ? undef
    : ( $blc
      ? Digest::MD5 -> new -> add ( $blc ) -> hexdigest
      : Wotsap::SUM_NOB . $kid
      )
    ) ;
  }

###################################################################
package Wotsap::Keyserver ;
use base 'OBB' ; __PACKAGE__ -> mk_getset ( qw(fqdn UA tout) ) ;

use constant
  { MIN  => 8
  , MAX  => 1024
  , INCR => 8
  } ;

our $AGENT = sprintf 'wotsap ; %s@%s', scalar getpwuid $<
  , map { chomp ; $_ } `hostname` ;

sub Init
  { my $self = shift ;
    $self -> OBB::Init ( @_ ) ;
    $self -> Xit ( "Wotsap::Keyserver: fqdn is empty" ) unless $self -> fqdn ;
    $self -> tout ( MIN ) ;
    $self -> UA ( $self -> mk_UA ) ;
    $self ;
  }

sub mk_UA
  { my $self = shift ;
    my $UA   = $self -> UA ;
    $UA -> conn_cache -> drop if $UA and $UA -> conn_cache -> get_connections ;
    LWP::UserAgent -> new
      ( timeout => $self -> tout , agent => $AGENT , keep_alive => 1 ) ;
  }

sub _search_url
  { my $self = shift ;
    my $kid  = shift ;
    sprintf 'http://%s/pks/lookup?op=get&search=0x%s', $self -> fqdn, $kid ;
  }

sub _get_key
  { my $self = shift ;
    my $kid  = shift ;
    my $succ = '' ;
    my $res  = Wotsap::Result -> Make ( kid => $kid ) ;
    my $t_start  = time ;
    my $response = $self -> UA -> get ( $self -> _search_url ( $kid ) ) ;
    my $rsl = $response -> status_line ;
    my $t_finish = time ;
    my $t_ival = int ( $t_finish - $t_start + 0.5 ) ;
    OBB::TV ( "kserv get   %s status %s", $kid, $rsl ) ;
    if ( $succ = $response -> is_success )
      { my $txt = $response -> decoded_content ;
        my $bgn = qr(-----BEGIN PGP PUBLIC KEY BLOCK) ;
        my $end = qr(END PGP PUBLIC KEY BLOCK-----) ;
        if ( $txt =~ /($bgn.*$end)/s )
          { $res -> blc ( $1 . "\n" ) ; }
        $self -> tout ( MIN ) ;
      }
    # Error handling request: No keys found
    elsif ( $rsl eq '500 OK' or $rsl eq '404 Not found' )
      { $self -> tout ( MIN ) ; }
    # got 500 read timeout
    elsif ( $rsl eq '500 read timeout' )
      { printf "TIMEOUT [%s] is_success [%s] line [%s] [%s,%s] ival %s\n"
          , $kid, $succ, $rsl , $t_start, $t_finish, $t_ival ;
        $res -> timeout ( 1 ) ;
      }
    # bad host : 500 Can't connect to xxx_pgp.surfnet.nl:80
    else
      { my $err = sprintf "kid [%s] succ [%s] line [%s] [%s,%s] ival %s\n"
          , $kid, $succ, $rsl, $t_start, $t_finish, $t_ival ;
        print $err ;
        $res -> blc ( '' ) ;
        $res -> err ( $rsl ) ;
      }
    $res ;
  }

# Wotsap::Keyserver ;
sub get_key
  { my $self = shift ;
    my $xxx  = shift ;
    my $kid  = ( ref $xxx ? $xxx -> kid : $xxx ) ;
    my $res  ;
    my $trys = 0 ;
    while ( ( $res = $self -> _get_key ( $kid ) ) -> timeout )
      { my $tout = $self -> tout ;
        $self -> tout ( $tout + INCR ) unless $tout > MAX ;
        $self -> UA ( $self -> mk_UA ) ;
        printf "NEW UA ; trys == %d ; timeout == %d\n"
          , $trys , $self -> UA -> timeout ;
        if ( ++ $trys >= 30 )
          { $self -> err ( 'bailing out ; trys %s', $trys ) ; last ; }
      }
    $res ;
  }

###################################################################
package Wotsap::Keyring ;
use base 'OBB' ; __PACKAGE__ -> mk_getset ( qw(path gpg have) ) ;

sub Init
  { my $self = shift ;
    my %opts = ( gpg => Wotsap::Meta::PRG_GPG ) ;
    $self -> OBB::Init ( %opts, @_ ) ;
    $self -> Xit ( "Wotsap::Keyring path is empty" ) unless $self -> path ;
    $self ;
  }

sub mk_have
  { my $self = shift ;
    my $gpg  = $self -> gpg ;
    my $path = $self -> path ;
    my $GPG = "$gpg --home $path --with-colons --list-keys" ;
    print "running [$GPG] ...\n" if $self -> Verbose ;
    my $res = {} ;
    open GPG, '-|', $GPG or $self -> Xit ( "can't popen $GPG ($!)" ) ;
    while ( <GPG> )
      { next unless /^pub:/ ;
        my $kid = ( split /:/, $_ ) [ 4 ] ;
        $res -> { lc $kid } ++ ;
      }
    close GPG ;
    $res ;
  }

sub has
  { my $self = shift ;
    my $kid  = shift ;
    $self -> have ( $self -> mk_have ) unless $self -> have ;
    return undef unless $self -> have ;
    $self -> have -> { $kid } ;
  }

# Wotsap::Keyring ;
sub get_key
  { my $self = shift ;
    my $xxx = shift ;
    my $kid = ( ref $xxx ? $xxx -> kid : $xxx ) ;
    my $res = Wotsap::Result -> Make ( kid => $kid ) ;
    return $res unless $self -> has ( $kid ) ;
    my @GPG =
      ( $self -> gpg
      , '-a'
      , '--homedir'
      , $self -> path
      , '--export'
      , $kid
      ) ;
    my $GPG = join ' ', @GPG ;
    $GPG .= ' 2> /dev/null' unless $self -> Verbose ;
    print "running $GPG ...\n" if $self -> Verbose ;
    open GPG, '-|', $GPG or $self -> Xit ( "failed %s ($!)", $GPG ) ;
    my $blc = join '', <GPG> ;
    close GPG ;
    my $bgn = qr(-----BEGIN PGP PUBLIC KEY BLOCK) ;
    my $end = qr(END PGP PUBLIC KEY BLOCK-----) ;
    if ( $blc =~ /($bgn.*$end)/s )
      { $res -> blc ( $1 . "\n" ) ; }
    $res ;
  }

###################################################################
package Wotsap::DUMP ;
use base 'OBB' ; __PACKAGE__ -> mk_getset
  ( qw(path) ) ;

sub Init
  { my $self = shift ;
    my $path = $self -> path ;
    $self -> Xit ( "Wot::Dir: path is empty" ) unless $path ;
    -d $path or mkpath ( $path, 0, 0755 ) ;
    $self ;
  }

###################################################################
package Wotsap::Wot::Dir ;
use base 'OBB' ; __PACKAGE__ -> mk_getset
  ( qw(path) ) ;

use constant CHUNKS => qw(README WOTVERSION names keys signatures debug) ;

sub Init
  { my $self = shift ;
    my $path = $self -> path ;
    $self -> Xit ( "Wot::Dir: path is empty" ) unless $path ;
    -d $path or mkpath ( $path, 0, 0755 ) ;
    $self ;
  }

###################################################################
package App::Commands ;
use base 'OBB' ;
__PACKAGE__ -> mk_getset ( qw(main cmds) ) ;

sub Init
  { my $self = shift ;
    my @args = @_ ;
    my @LIST = $self -> LIST ;
    my %HASH = $self -> HASH ;
    my $cnt  = 0  ;
    my $list = [] ;
    my $tmp  = [] ;
    for my $x ( @args )
      { if ( exists $HASH { $x } )
          { push @$list, $tmp ; $tmp = [ $x ] ; }
        else
          { push @$tmp, $x ; }
      }
    push @$list, $tmp ;
    $self -> main ( shift @$list ) ;
    $self -> cmds ( [] ) ;
    for my $itm ( @$list )
      { @ARGV = @$itm ;
        my $name = shift @ARGV ;
        my $opts = {} ;
        my $spec = $HASH { $name } ;
        Getopt::Long::GetOptions ( $opts, ref $spec ? @$spec : $spec )
          or die ( "error in GetOptions for command $name\n" ) ;
        my $pack = $self -> pack ( $name ) ;
        push @{ $self -> cmds }, $pack -> Make
          ( name => $name, args => [ @ARGV ], opts => $opts ) ;
      }
    $self ;
  }

sub usage
  { my $self = shift ;
    my @LIST = $self -> LIST ;
    my @res  = () ;
    for my $name ( @LIST )
      { my $pack = $self -> pack ( $name ) ;
        my $cmd  = $pack -> Make ( name => $name ) ;
        push @res, $cmd -> usage ;
      }
    join '', @res ;
  } ;

sub has_make
  { my $self = shift ;
    scalar grep $_ -> name eq 'make', @{ $self -> cmds } ;
  }

sub pack
  { my $self = shift ;
    my $name = ucfirst lc shift ;
    my $pack = ref $self || $self ;
    sprintf '%s::%s', substr ( $pack, 0, -1 ), $name ;
  }

###################################################################
package App::Command ;
use base 'OBB' ;
__PACKAGE__ -> mk_getset ( qw(name args opts) ) ;
sub Defs { ( name => 'no_name', args => [], opts => {} ) ; } ;

sub dmp
  { my $self = shift ;
    my $res = '' ;
    $res .= sprintf "  name [%s]\n", $self -> name ;
    $res .= sprintf "  args [%s]\n", join ',', @{ $self -> args } ;
    $res .= sprintf "  opts [%s]\n", join ',', %{ $self -> opts } ;
  }

sub main { my $self = shift ; $self -> dmp ; }

sub usage
  { my $self = shift ; sprintf "Usage: %s\n", $self -> name ; }

###################################################################
package Wotsap::Commands ;
use base 'App::Commands' ;

my @LIST = qw(make open info import check reset update scc export xpaths) ;
my %HASH =
  ( make   => [ qw(k=s g=s r=s) ]
  , open   => ''
  , info   => [ qw(v) ]
  , import => ''
  , reset  => [ qw(keysum=s keybad=s) ]
  , update => [ qw(reset cache=i) ]
  , scc    => ''
  , check  => ''
  , export => ''
  , xpaths  => [ qw(j r m=i) ]
  ) ;

sub LIST { @LIST ; }
sub HASH { %HASH ; }

###################################################################
package Wotsap::Command::Make ;
use base 'App::Command' ;

sub usage
  { sprintf "Usage: make [-g path/to/gpg] [-k key_server] [-r root_key]\n" ; }

sub main # make
  { my $self = shift ;
    my $W    = shift ;
    my $args = $self -> args ;
    my $opts = $self -> opts ;
    $self -> Xit ( $self -> usage ) if @$args ;
    $W -> meta -> kserver ( $opts -> {k} ) if $opts -> {k} ;
    $W -> meta -> prg_gpg ( $opts -> {g} ) if $opts -> {g} ;
    $W -> rootkid ( $opts -> {r} ) if $opts -> {r} ;
  }

###################################################################
package Wotsap::Command::Info ;
use base 'App::Command' ;

sub usage { sprintf "Usage: info [-v] [key_id]\n" ; }

sub info1
  { my $self = shift ;
    my $W    = shift ;
    my $vers = $W -> meta -> version ;
    my $keys = $vers ? $W -> keys -> count : '<none>' ;

    printf "keys    : %s\n", $keys ;
    my $type = $W -> meta -> db_type ;
    if ( $vers and $type and $type eq Wotsap::DB_EXPT )
      { my $w = 1 + int ( $keys > 0 ? log ( $keys ) / log ( 10 ) : 0 ) ;

        my $done = $W -> keys -> count
          ( where => "done != 0 and bad = ''" ) ;
        printf "-> done : %${w}d\n", $done ;

        my $todo = $W -> keys -> count
          ( where => "done = 0 and bad = ''" ) ;
        printf "-> todo : %${w}d\n", $todo ;

        my $bads = $W -> keys -> count
          ( where => "bad != ''" ) ;
        printf "-> bad  : %${w}d\n", $bads ;

        my $wids = $W -> keys -> count
          ( where => "wid = 1" ) ;
        printf "-> wid  : %${w}d\n", $wids ;
      }

    my $sigs = $vers ? $W -> sigs -> count : '<none>' ;
    printf "sigs    : %s\n", $sigs ;
  }

sub info2
  { my $self = shift ;
    my $W    = shift ;
    my @keys = @_ ;
    my $type = $W -> meta -> db_type ;
    my $WID  = ( $type and $type eq Wotsap::DB_EXPT ) ? undef : 1 ;
    for my $key ( @keys )
      { my $bad = $key -> bad ;
        my $wid = $WID || $key -> wid ;
        printf "  %s %s %s %s\n"
          , $key -> kid
          , ( $wid ? '+' : '-' )
          , $key -> uid
          , ( $bad ? "[$bad]" : '' )
          ;
      }
  }

sub main # info
  { my $self = shift ;
    my $W    = shift ;
    my $args = $self -> args ;
    my $opts = $self -> opts ;
    $self -> Xit ( $self -> usage ) if @$args > 1 ;
    my $res ;

    my $cols = $W -> meta -> cols ;
    for my $col ( @$cols )
      { my $val = $W -> meta -> $col ;
        printf "%s : %s\n", $col, $val || '<none>' ;
      }

    if ( @$args )
      { my $kid = lc shift @$args ;
        $kid = $W -> rootkid if $kid eq 'root' ;
        my $key = $W -> find_key ( $kid ) ;
        print "key : $kid\n" ;
        if ( $key )
          { for my $tag ( qw(id kid sum bad uid wid done redo) )
              { printf "-> %4s : %s\n", $tag, Util::diag $key -> $tag ; }
            my @sigs = $key -> signed_by ;
            printf "-> %-6s : %s\n", 'sigs', scalar @sigs ;
            $self -> info2 ( $W, @sigs ) if $opts -> {v} ;
            my @sigd = $key -> has_signed ;
            printf "-> %-6s : %s\n", 'signed', scalar @sigd ;
            $self -> info2 ( $W, @sigd ) if $opts -> {v} ;
            $res = $kid ;
          }
        else
          { printf "  not found\n" ; }
      }
    else
      { $self -> info1 ( $W ) ; }
    $res ;
  }

###################################################################
package Wotsap::Command::Open ;
use base 'App::Command' ;

sub main # open
  { my $self = shift ;
    my $W    = shift ;
    my $args = $self -> args ;
    my $opts = $self -> opts ;
    $self -> Xit ( $self -> usage ) if @$args ;
    exec sprintf "sqlite3 %s", $W -> p_lite ;
  }

###################################################################
package Wotsap::Command::Import ;
use base 'App::Command' ;

use constant IMPORT_WOT => Wotsap::FS_WOTF ;
use constant IMPORT_TMP => Wotsap::FS_TEMP . '/' . IMPORT_WOT ;

sub get_file
  { my $self = shift ;
    my $file = shift ;
    my $buff = '' ;
    my $res  = '' ;
    open FILE, $file or $self -> Xit ( "can't open $file ($!)" ) ;
    while ( sysread FILE, $buff, 1024 ) { $res .= $buff ; }
    close FILE ;
    $res ;
  }

# returns [ [ $idx, $nam, $key ], ... ]
sub names_keys
  { my $self = shift ;
    my $NAMS = shift ;
    my $KEYS = shift ;
    my $KEYT = shift ;
    my $klen = shift ; # 8 or 16
    my $keys = $self -> get_file ( $KEYS ) ;
    my $res  = [] ;
    my %keys = () ;
    my $pnt  = 0 ;
    my $idx  = 0 ;
    open NAMS, $NAMS or $self -> Xit ( "can't open $NAMS ($!)" ) ;
    while ( <NAMS> ) { chop ; push @$res, [ $idx ++, $_ ] unless /^#/ ; }
    close NAMS ;
    $self -> Xit ( "weird size for 'keys' [%s]", length $keys )
      unless length $keys == $klen / 2 * scalar @$res ;
    for my $tup ( @$res )
      { my $key = '' ;
        for ( my $i = $klen ; $i > 0 ; $i -= 8 )
          { my $word = substr $keys, $pnt, 4 ;
            $key .= sprintf "%08x", unpack "N", $word ;
            $pnt += 4 ;
          }
        print "*** double key '$key'\n" if $keys { $key } ;
        $keys { $key } ++ ;
        push @$tup, $key ;
      }
    open KEYT, '>', $KEYT or $self -> Xit ( "can't write $KEYT ($!)" ) ;
    printf KEYT "%s\n", $_ -> [ 2 ] for @$res ;
    close KEYT ;
    $res ;
  }

sub signatures
  { my $self = shift ;
    my $SIGS = shift ;
    my $SIGT = shift ;
    my $size = shift ;
    my $MRKD = shift ;
    my $sigs = $self -> get_file ( $SIGS ) ;
    my $len = length $sigs ;
    my $pnt = 0 ;
    $self -> Xit ( "weird size for '%s' [%s]", $SIGS, $len )
      if $len % 4 ;

    my $getw = sub
      { die "too short" if $pnt > $len ;
        my $res = substr $sigs, $pnt, 4 ;
        $pnt += 4 ;
        $res ;
      } ;

    my $res = [] ;
    my @txt = () ;
    my $sep = "\xFF\xFF\xFF\xFF" ;
    my $num_mask = unpack "N", "\x0F\xFF\xFF\xFF" ;
    my $tag_mask = ~ $num_mask ;
    my $last ;

    for ( my $dst = 0 ; $dst < $size ; $dst ++ )
      { my @words = () ;
        my @sigs  = () ;
        if ( $MRKD )
          { while ( $pnt < $len )
              { my $word = &$getw() ;
                last if $word eq $sep ;
                push @words, $word ;
              }
          }
        else
          { my $cnt = unpack 'N', &$getw() ;
            for ( my $i = 0 ; $i < $cnt ; $i ++ )
              { push @words, &$getw() ; }
          }
        for my $word ( @words )
          { my $tmp = unpack "N", $word ;
            my $src = $tmp & $num_mask ;
            my $tag = ( $tmp & $tag_mask ) >> 28 ;
            die "bad index '$src'" if $src < 0 or $src > $size ;
            push @$res, [ $src, $dst, $tag ] ;
            push @sigs, "$src,$tag" ;
          }

        push @txt, [ $dst, @sigs ] ;
      }

    die "too long ; pnt [$pnt] len [$len]\n" if $pnt != $len ;

    open SIGT, '>', $SIGT or $self -> Xit ( "can't write $SIGT ($!)" ) ;
    printf SIGT "%s\n", join ' ', @$_ for @txt ;
    close SIGT ;
    $res ;
  }

sub usage { sprintf "Usage: import wotsap-file\n" ; }

sub main # import
  { my $self = shift ;
    my $W    = shift ;
    my $args = $self -> args ;
    $self -> Xit ( $self -> usage ) unless @$args == 1 ;

    my $file = shift @$args ;
    my $wot  = $W -> p4 ( IMPORT_WOT ) ;
    my $tmp  = $W -> p4 ( IMPORT_TMP ) ;
    my $buf  = '' ;
    $self -> Xit ( "no such file [$file]" ) unless -f $file ;

    # copy $wot to $file
    open FILE, $file or $self -> Xit ( "can't open $file ($!)" ) ;
    open WOTF, '>', $wot or $self -> Xit ( "can't write $wot ($!)" ) ;
    while ( sysread FILE, $buf, 1024 ) { syswrite WOTF, $buf ; }
    close WOTF ;
    close FILE ;

    # decompress & ar -x
    system sprintf 'bzcat %s > %s', $wot, $tmp ;
    system sprintf 'cd %s ; ar -x %s', $W -> path, IMPORT_TMP ;
    unlink $tmp ;

    # prep db
    $W -> Require ( db_type => Wotsap::DB_IMPT ) ;
    my $vers = $W -> meta -> version ( $W -> wot_version ) ;
    printf "import version : $vers\n" ;
    $W -> mk_tabs ;

    # unpack
    my $tups = $self -> names_keys
      ( $W -> p_nams, $W -> p_keys, $W -> p_keyt, $vers lt '0.3' ? 8 : 16 ) ;
    my $sigs = $self -> signatures
      ( $W -> p_sigs, $W -> p_sigt, scalar @$tups, $vers =~ /^0.1/ ) ;

    # insert
    printf "deleting keys and sigs ...\n" if $self -> Verbose ;
    $W -> query ( "DELETE FROM keys" ) ;
    printf "vacuming ...\n" if $self -> Verbose ;
    $W -> query ( "VACUUM" ) ;
    printf "inserting %6d keys ...\n", scalar @$tups ;
    my $cols = [ qw(id uid kid) ] ;
    $W -> keys -> Wotsap::Tab::insert ( cols => $cols, args => $tups ) ;
    print "done\n" ;
    printf "inserting %6d sigs ...\n", scalar @$sigs ;
    $cols = [ qw(src dst lvl) ] ;
    $W -> sigs -> Wotsap::Tab::insert ( cols => $cols, args => $sigs ) ;
    print "done\n" ;

    # check
    print "checking properties ...\n" ;
    my $check = Wotsap::Command::Check::check
      ( [ map { src => $_ -> [ 0 ] , dst => $_ -> [ 1 ] }, @$sigs ]
      , scalar @$tups
      ) ;
    printf "check : %s\n", $check ? 'ok' : 'not ok' ;
  }

###################################################################
package Wotsap::Command::Export ;
use base 'App::Command' ;

use constant SORT_WD => Wotsap::SORT_WD ;

sub gen_file
  { my $self = shift ;
    my $file = shift ;
    my $text = shift ;
    open FILE, '>', $file or $self -> Xit ( "can't write $file ($!)" ) ;
    print FILE $text ;
    close FILE ;
  }

sub names_keys
  { my $self = shift ;
    my $NAMS = shift ;
    my $KEYS = shift ;
    my $keys = shift ;
    my $vers = shift ;
    printf "exporting to $NAMS and $KEYS [%d] ...\n", scalar @$keys ;
    open NAMS, '>',     $NAMS or $self -> Xit ( "can't write $NAMS ($!)" ) ;
    open KEYS, '>:raw', $KEYS or $self -> Xit ( "can't write $KEYS ($!)" ) ;
    my $cnt = 0 ;
    for my $key ( @$keys )
      { printf NAMS "%s\n", $key -> uid ;
        my $kid = $key -> kid ;
        $kid = substr $kid, -8 if $vers eq '0.2' ;
        while ( length $kid )
          { my $prt = substr $kid, 0, 8, '' ;
            my $pck = pack 'N', hex $prt ;
            print KEYS $pck ;
          }
      }
    close NAMS ;
    close KEYS ;
  }

sub signatures
  { my $self = shift ;
    my $SIGS = shift ;
    my $keys = shift ;
    my $sigs = shift ;
    my %idxs = () ;

    for ( my $i = 0 ; $i < @$keys ; $i ++ )
      { $idxs { $keys -> [ $i ] -> id } = $i ; }

    printf "exporting to $SIGS [%d] ...\n", scalar @$sigs ;
    for my $sig ( @$sigs )
      { my $src = $sig -> {src} ;
        my $dst = $sig -> {dst} ;
        for ( $src, $dst )
          { $self -> Xit ( "no idx for src/dst id %d", $_ )
              unless exists $idxs { $_ } ;
          }
        my $key = $keys -> [ $idxs { $dst } ] ;
        $key -> {_sgs} = [] unless defined $key -> {_sgs} ;
        push @{ $key -> {_sgs} }, $sig ;
      }

    open SIGS, '>:raw', $SIGS or $self -> Xit ( "can't write $SIGS ($!)" ) ;
    for my $key ( @$keys )
      { my $sgs = $key -> {_sgs} ;
        print SIGS pack 'N', scalar @$sgs ;
        for my $sig ( @$sgs )
          { my $src = $idxs { $sig -> {src} } ;
            my $lvl = $sig -> {lvl} << 28 ;
            my $pck = pack 'N', $src | $lvl ;
            print SIGS $pck ;
          }
      }
    close SIGS ;
  }

sub gen_readme
  { my $self = shift ;
    my $READ = shift ;
    my $vers = shift ;
    my $base = shift ;
    my $serv = $base -> meta -> kserver ;
    my $tim0 = scalar localtime $base -> time0 ;
    my $tim1 = scalar localtime $base -> time1 ;
    my $text = <<TXT ;
This is a Web of Trust archive.

format : $vers
server : $serv
start  : $tim0
finish : $tim1
using  : Wotsap.pm version @{[Wotsap -> Version]}
TXT
    $self -> gen_file ( $READ, $text ) ;
  }

sub usage { sprintf "Usage: export [-v version]\n" ; }

sub main # export
  { my $self = shift ;
    my $W    = shift ;
    my $args = $self -> args ;
    my $dir  = $W -> p_expt ;
    my $wot  = $W -> p_expw ;
    my $tmp  = "$wot.tmp" ;
    my $NAMS = sprintf "%s/%s", $dir, Wotsap::FS_NAMS ;
    my $KEYS = sprintf "%s/%s", $dir, Wotsap::FS_KEYS ;
    my $SIGS = sprintf "%s/%s", $dir, Wotsap::FS_SIGS ;
    my $WOTV = sprintf "%s/%s", $dir, Wotsap::FS_WOTV ;
    my $READ = sprintf "%s/%s", $dir, Wotsap::FS_READ ;

    $self -> Xit ( $self -> usage ) if @$args > 1 ;
    my $vers = shift @$args || '0.3' ;
    die "[error] can't export version '$vers'\n" if $vers !~ /^0\.[23]$/ ;

    $W -> Init
      ( version => '0.3'
      , db_type => Wotsap::DB_EXPT
      ) ;

    -d $dir or mkdir $dir, 0777 or $self -> Xit ( "can't mkdir $dir ($!)" ) ;

    printf "selecting keys ...\n" ;
    my $keys =
      [ $W -> keys -> select ( where => 'wid = 1', order_by => SORT_WD ) ] ;
    my $from = 'sigs '
      . 'left join keys as ksrc on ( sigs.src = ksrc.id ) '
      . 'left join keys as kdst on ( sigs.dst = kdst.id ) ' ;
    my $qwe = 'ksrc.wid = 1 and kdst.wid = 1' ;
    printf "selecting signatures ...\n" ;
    my $sigs =
      [ $W -> sigs -> select ( from => $from, where => $qwe, as_recs => 0 ) ] ;
    $self -> gen_file   ( $WOTV, "$vers\n" ) ;
    $self -> gen_readme ( $READ, $vers, $W ) ;
    $self -> names_keys ( $NAMS, $KEYS, $keys, $vers ) ;
    $self -> signatures ( $SIGS, $keys, $sigs ) ;
    unlink $tmp ;
    system sprintf 'ar -cv -q %s %s/*', $tmp, $dir ;
    system sprintf 'bzip2 -c %s > %s' , $tmp, $wot ;
    unlink $tmp ;
  }

###################################################################
package Wotsap::Command::Reset ;
use base 'App::Command' ;

sub usage { sprintf "Usage: reset [-keysum where] [-keybad where]\n" ; }

sub reset
  { my $self = shift ;
    my $W    = shift ;
    printf "resetting done's ...\n" ;
    $W -> query ( 'UPDATE keys SET done = NULL' ) ;
    printf "resetting done's done\n" ;
  }

sub main # info
  { my $self = shift ;
    my $W    = shift ;
    my $args = $self -> args ;
    my $opts = $self -> opts ;
    my $osum = $opts -> {keysum} ;
    my $obad = $opts -> {keybad} ;
    $self -> Xit ( $self -> usage ) if @$args > 0 ;

    $W -> Require
      ( version => '0.3'
      , db_type => Wotsap::DB_EXPT
      ) ;

    $W -> keys -> reset_all_sums ( $osum ) if $osum ;
    $W -> keys -> reset_all_bads ( $obad ) if $obad ;

    $self -> reset ( $W ) ;
  }

###################################################################
package Wotsap::Command::Update ;
use base 'App::Command' ;

our $DEF_MAX = 1 ;
our $NO = Wotsap::NO ;
our $news = 0 ;
our $W ;
our @first = () ;
our $KID ;

sub init
  { if ( $KID )
      { my $key = $W -> key ( $KID ) ;
        unless ( $key )
          { $key = $W -> mk_key ( $KID ) ;
            $W -> keys -> save ( $key ) ;
          }
        $key -> set_for_todo ;
        @first = ( $key ) ;
      }
    else
      { my $todo = $W -> keys -> count ( where => "done = 0" ) ;
        if ( ! $todo )
          { # start with root unless root.done
            my $root = $W -> key ( $W -> rootkid ) ;
            if ( ! $root )
              { $root = $W -> mk_key ( $W -> rootkid ) ;
                $W -> keys -> save ( $root ) ;
              }
            if ( ! $root -> done )
              { $root -> mark_as_todo ; }
          }
      }

    print "--------------------------------\n" ;
  }

sub get_one_todo
  { @first ? pop @first : $W -> keys -> select1 ( where => "done = 0" ) ; }

sub add_todo_sigs
  { my $key = shift ;
    my @sgs = $W -> get_todo_sigs ( $key ) ;
    # signer has : done is NULL, bad = NO or redo
    $W -> keys -> mark_as_todo ( [ map $_ -> {id}, @sgs ] ) ;
    scalar @sgs ;
  }

sub usage { sprintf "Usage: update [-cache days] max [kid]\n" ; }

sub main # update
  { my $self = shift ;
    my $BASE = shift ;
    my $args = $self -> args ;
    my $opts = $self -> opts ;
    $self -> Xit ( $self -> usage ) unless 1 <= @$args and @$args <= 2 ;

    $W = $BASE -> Require
      ( version => '0.3'
      , db_type => Wotsap::DB_EXPT
      ) ;

    my $kserver = $W -> meta -> kserver ;
    $self -> Die ( "can't find a key-server" ) unless $kserver ;
    $self -> Die ( "no root key" ) unless $W -> rootkid ;

    my $MAX = shift @$args ;

    unless ( $MAX =~ /^\d+$/ )
      { $self -> Xit ( "max ($MAX) is not a number" ) ; }

    $KID = shift @$args ; # optional
    my $KID_done ;
    if ( $KID )
      { $KID = $W -> rootkid if $KID eq 'root' ;
        my $err = $W -> bad_kid ( $KID ) ;
        $W -> Die ( $err ) if $err ;
        $MAX = 1 ;
        my $key = $W -> key ( $KID ) ;
        $KID_done = $key -> done if $key ;
        OBB::TD ( "set KID_done %s", $KID_done ) ;
      }

    if ( defined $opts -> {cache} )
      { $W -> add_cache ( $opts -> {cache} ) ;
        OBB::TV ( 'add cache' ) ;
      }

    init ;

    my $cnt  = 0 ;
    my $done = $W -> keys -> count ( where => 'done > 0' ) ;
    my $todo = $W -> keys -> count ( where => 'done = 0' ) ;
    my %upds = () ;
    my $qbad = 0 ;
    my $qdon = 0 ;

    printf "MAX %s DONE %d TODO %d\n", ( $MAX || 'no_limit' ), $done, $todo ;

    while ( my $key = get_one_todo )
      { my $kid = $key -> kid ;
        my $id  = $key -> id ;
        my $was = $key -> bad ;
        my $bad = $was ;
        my $upd = 0 ;
        my $hit = 0 ;
        my $add = 0 ;
        my $sgs = 0 ;

        if ( $key -> done )
          { printf "%s : $kid already done %s\n"
              , $done, scalar localtime $key -> done ;
            $qdon ++ ;
            $todo -- ;
            next ;
          }

        if ( $was and $was ne 'expired' )
          { $bad = 'SKIP' ; $qbad ++ ; }
        else
          { my $Res = $W -> refresh ( $key ) ;
            my $err = $Res -> err ;
            $upd = $Res -> upd ;
            $hit = $Res -> hit ;
            $bad = $key -> bad ;
            $W -> Xit ( $err ) if $err ;
            if ( $bad )
              { $key -> drop_sigs_by_me if $bad eq 'revoked' ; }
            else
              { $add = add_todo_sigs ( $key ) ; }
            if ( ! defined $upd )
              { $upds { timeout } ++ ; }
            elsif ( $upd )
              { $news ++ if $upd eq 'new' ;
                $upds { $bad || 'not bad' } ++ ;
              }
          }

        $key -> mark_as_done ;
        $todo += $add - 1 ;
        $sgs = $W -> sigs -> count ( where => "dst = $id" ) ;

        printf "%d %s %-4s sigs %3s addq %3s todo %d %s%s\n"
          , $done + 1
          , $kid
          , ( $upd || '' )
          , ( $sgs || '' )
          , ( $add || '' )
          , $todo
          , ( $W -> cache ? ( $hit ? 'H' : ' ' ) . ' ' : '' )
          , ( ( $was or $bad )
            ? sprintf "%s -> %s", ( $was || 'ok' ), ( $bad || 'ok' )
            : ''
            )
          ;

        $done ++ ;
        $cnt  ++ ; last if $cnt == $MAX ;
      }

    if ( $KID )
      { my $val = defined $KID_done ? $KID_done : 'NULL' ;
        OBB::TD ( "get KID_done %s", $KID_done ) ;
        $W -> query
          ( "UPDATE keys SET done = $val WHERE kid = '$KID'" ) ;
      }

    printf "begin : %s\n", scalar localtime $W -> time0 ;
    printf "end   : %s\n", scalar localtime $W -> time1 ;
    my $tot = 0 ; for my $bad ( sort keys %upds ) { $tot += $upds { $bad } ; }
    printf "new keys : %d\n", $news ;
    printf "updates  : %d\n", $tot ;
    for my $bad ( sort keys %upds )
      { printf "-- %s : %s\n", $bad, $upds { $bad } ; }
    printf "should be 0 ; bad in queue : %d\n", $qbad if $qbad ;
    printf "should be 0 ; already done : %d\n", $qdon if $qdon ;
  }

###################################################################
package Wotsap::Command::Scc ;
use base 'App::Command' ;

use constant
  { PTH => '.'
  , OQ  => 'x.oq'
  , NQ  => 'x.nq'
  , RX  => 'x.rx'
  , XR  => 'x.xr'
  , SC  => 'x.scc'
  , BD  => 'x.bad'
  , SRC => 'src'
  , DST => 'dst'
  , SORT_WD => Wotsap::SORT_WD
  } ;

our $W ;

sub Error { OBB -> Xit ( @_ ) ; }

sub max
  { return undef unless @_ ;
    my $max = shift @_ ;
    for ( @_ ) { $max = $_ if $_ > $max ; }
    $max ;
  }

sub count ($)
  { my $name = shift ;
    ( $W -> get_tups ( "select count(*) as c from $name" ) ) [ 0 ] -> { c } ;
  }

sub count_sql
  { my $name = shift ;
    my $sql  = shift ;
    ( $W -> get_tups ( "select count(*) as c from $name where $sql" )
    ) [ 0 ] -> { c } ;
  }

sub show
  { OBB::A_is 3, scalar @_ ;
    my $r = shift ; # reachable ; XR or RX
    my $q = shift ; # queue
    my $t = shift ; # tag
    my $m = count $r ; # marked
    my $c = count $q ; # queued
    printf "%4s found %6d queued %6d\n", $t, $m, $c ;
    $c ;
  }

sub query
  { my $SQL = shift ;
    for my $sql ( split /---\n/, $SQL )
      { chomp $sql ;
        printf "%s\n", $sql if $W -> Debug ;
        $W -> dbh -> do ( $sql ) or Error ( $W -> dbh -> errstr ) ;
      }
  }

sub init
  { <<SQL ;
attach ':memory:' as x ;
---
create table @{[RX]} ( id integer PRIMARY KEY not null ) ;
---
create table @{[XR]} ( id integer PRIMARY KEY not null ) ;
---
create table @{[OQ]} ( id integer PRIMARY KEY not null ) ;
---
create table @{[NQ]} ( id integer PRIMARY KEY not null ) ;
---
create table @{[SC]} ( id integer PRIMARY KEY not null ) ;
---
create table @{[BD]} ( id integer PRIMARY KEY not null ) ;
---
insert into @{[BD]} select id from keys where bad != '' ;
SQL
  }

sub init_oq
  { sprintf "insert into %s values ( '%s' )", OQ, shift ; }

sub loop
  { OBB::A_is 1, scalar @_ ;
    my $xx = shift ;
    my ( $a, $b ) = $xx eq XR ? ( SRC, DST ) : ( DST, SRC ) ;
    <<SQL ;
delete from x.nq ;
---
insert into x.nq
  select distinct ( $a ) from sigs
  where $b in ( select id from x.oq )
  EXCEPT
  select id from $xx
  EXCEPT
  select id from @{[BD]} ;
---
insert into $xx select id from x.nq ;
---
delete from x.oq ;
---
insert into x.oq select id from x.nq ;
SQL
  }

sub final
  { my $SC = SC ;
    my $ss = join " INTERSECT " , map "select id from $_", ( XR, RX ) ;
    <<SQL ;
insert into @{[SC]} $ss
---
update keys SET wid = id in ( SELECT x.scc.id FROM x.scc )
SQL
  }

sub Rename
  { my $fil = shift ;
    my $new = shift ;
    my $old = shift ;
    unlink $old if -f $old ;
    if ( -f $fil )
      { rename $fil, $old or Error "can't rename $fil, $old ($!)" ; }
    rename $new, $fil or Error "can't rename $new, $fil ($!)" ;
  }

my $tags =
  { Wotsap::Command::Scc::XR => 'x to root'
  , Wotsap::Command::Scc::RX => 'root to x'
  , Wotsap::Command::Scc::SC => 'strong set'
  , 'keys'   => 'wotsap keys'
  } ;
my $w = max map { length $_ } values %$tags ;
sub tag ($) { $tags -> { $_[0] } || $_[0] ; }

sub save
  { my $tags = shift ;
    my $path = $W -> path ;
    my $file = "$path/SCC" ;
    my $NEW = "$file.new" ;
    my $OLD = "$file.old" ;
    my $sub ;
    my $qwe ;
    Error "can't find directory $path" unless -d $path ;
    open NEW, '>', $NEW or Error "can't write $NEW ($!)" ;
    $sub = sprintf 'select id from %s', SC ;
    $qwe = "SELECT kid FROM keys WHERE id IN ( $sub ) ORDER BY kid" ;
    for my $hash ( $W -> get_tups ( $qwe ) )
      { printf NEW "%s\n", $hash -> { kid } ; }
    close NEW ;
    Rename $file, $NEW, $OLD ;

    for my $XX ( RX, XR )
      { ( my $name = tag $XX ) =~ s/\s/_/g ;
        my $file = sprintf "%s/%s-SCC", $path, $name ;
        my $NEW = "$file.new" ;
        my $OLD = "$file.old" ;

        open NEW, '>', $NEW or Error "can't write $NEW ($!)" ;
        my $scc = sprintf 'select id from %s', SC ;
        my $sub = sprintf "select id from $XX where id not in ( $scc )";
        printf NEW "%s\n", $_ -> kid for $W -> keys -> select
          ( cols => 'kid', where => "id in ( $sub )", order_by => SORT_WD ) ;
        close NEW ;
        Rename $file, $NEW, $OLD ;
      }
  }

sub main # scc
  { my $self = shift ;
    my $BASE = shift ;
    my $args = $self -> args ;
    my $opts = $self -> opts ;
    $self -> Xit ( $self -> usage ) if @$args ;

    $W = $BASE -> Require
      ( version => '0.3'
      , db_type => Wotsap::DB_EXPT
      ) ;

    my $root = $W -> rootkey or die 'no root' ;

    query init ;

    for my $XX ( XR, RX )
      { query init_oq $root -> id ;
        my $cnt = 0 ;
        my $q = show $XX, OQ, sprintf '%s oq', $XX ;
        my $loop = loop $XX ;
        while ( $q )
          { query $loop ;
            $q = show $XX, NQ, sprintf "%s %2d", $XX, $cnt ++ ;
          }
      }

    query final ;

    save ;

    printf "root %s\n", $root -> kid ;
    for my $tab ( XR, RX, SC, 'keys' )
      { printf "%-${w}s : %d\n", tag $tab, count $tab ; }
  }

###################################################################
package Wotsap::Command::Check ;
use base 'App::Command' ;

use constant SORT_WD => Wotsap::SORT_WD ;

sub _check
  { my $sigs = shift ;
    my $size = shift ;
    my $a = shift ;
    my $b = shift ;
    printf "marking $a -> $b ...\n" ;
    my @V ; for ( my $i = 0 ; $i < $size ; $i ++ ) { $V [ $i ] = [] ; }
    my @M ; for ( my $i = 0 ; $i < $size ; $i ++ ) { $M [ $i ] =  0 ; }
    my @Q = ( $sigs -> [ 0 ] { $a } ) ;
    my %Q = ( $sigs -> [ 0 ] { $a } => 1 ) ;
    for my $sig ( @$sigs )
      { my $x = $sig -> { $a } ;
        my $y = $sig -> { $b } ;
        die "bad index $x size[$size]" unless $x < $size ;
        die "bad index $y size[$size]" unless $y < $size ;
        push @{ $V [ $x ] }, $y ;
      }
    while ( @Q )
      { my $x = shift @Q ;
        next if $M [ $x ] ;
        $Q { $x } -- ; delete $Q { $x } unless $Q { $x } ;
        $M [ $x ] = 1 ;
        for my $y ( @{ $V [ $x ] } )
          { unless ( $M [ $y ] or $Q { $y } )
              { push @Q, $y ; $Q { $y } ++ ; }
          }
      }
    my $res = 0 ;
    for my $m ( @M ) { die "$m > 1" if $m > 1 ; $res += $m ; }
    printf "%sot ok ; marked $res of $size\n", ( $res == $size ? 'w' : 'n' ) ;
    $res == $size ;
  }

sub check
  { my $sigs = shift ;
    my $size = shift ;
    my $forw = _check $sigs, $size, 'src', 'dst' ;
    my $bckw = _check $sigs, $size, 'dst', 'src' ;
    $forw && $bckw ;
  }

sub main # check
  { my $self = shift ;
    my $W    = shift ;
    my $args = $self -> args ;
    my $opts = $self -> opts ;
    $self -> Xit ( $self -> usage ) if @$args ;

    my $vers = $W -> meta -> version ;
    my $type = $W -> meta -> db_type ;
    my $whe  = $type eq Wotsap::DB_EXPT ? 'wid = 1' : '' ;
    my $size = $W -> keys -> count ( where => $whe ) ;

    die "no keys ??" unless $size ;
    printf "keys    : $size\n" ;
    printf "version : $vers\n" ;
    printf "db type : $type\n" ;
    printf "selecting signatures ...\n" ;

    my $from = 'sigs '
      . 'left join keys as ksrc on ( sigs.src = ksrc.id ) '
      . 'left join keys as kdst on ( sigs.dst = kdst.id ) ' ;
    my $qwe =
      ( $type eq Wotsap::DB_EXPT
      ? 'ksrc.wid = 1 and kdst.wid = 1'
      : ''
      ) ;
    my $sigs =
      [ $W -> sigs -> select
          ( cols => 'src,dst', from => $from, where => $qwe, as_recs => 0 )
      ] ;
    die "no sigs ??" unless @$sigs ;
    printf "sigs    : @{[scalar @$sigs]}\n" ;
    if ( $type eq Wotsap::DB_EXPT )
      { printf "converting idxs for db type %s ...\n", Wotsap::DB_EXPT ;
        my $cnt = 0 ;
        my %idxs = () ;
        $idxs { $_ -> id } = $cnt ++
          for $W -> keys -> select
            ( where => 'wid = 1', order_by => SORT_WD ) ;
        $sigs =
          [ map
              { src => $idxs { $_ -> {src} }
              , dst => $idxs { $_ -> {dst} }
              }, @$sigs
          ] ;
      }
    my $res = check $sigs, $size ;
    printf "check : %s\n", $res ? 'ok' : 'not ok' ;
  }

###################################################################
package Wotsap::Command::Xpaths ;
use base 'App::Command' ;
use JSON::PP ;

sub usage { sprintf "Usage: xpaths [-j] [-r] [-m max] from to\n" ; }

sub xpaths # Xpaths
  { my $self = shift ;
    my $W    = shift ;
    my $SRC  = shift ;
    my $DST  = shift ;
    my $MAX  = shift ;
    return undef unless defined $SRC and defined $DST ;
    my $pts  = $W -> xpaths ( $SRC, $DST, $MAX ) ;
    my $res =
      { FROM   => $SRC
      , TO     => $DST
      , xpaths =>
          ( ( defined $pts )
          ? [ map { [ map { $W -> key ( $_ ) } @$_ ] } @$pts ]
          : undef
          )
      } ;
    $res ;
  }

sub json # Xpaths
  { my $self = shift ;
    my $W    = shift ;
    my $SRC  = shift ;
    my $DST  = shift ;
    my $MAX  = shift ;
    return undef unless defined $SRC and defined $DST ;
    my $pts  = $self -> xpaths ( $W, $SRC, $DST, $MAX ) -> {xpaths} ;
    my $res =
      { FROM   => $SRC -> jdmp
      , TO     => $DST -> jdmp
      , xpaths =>
          ( @$pts
          ? [ map { [ map { $_ -> jdmp } @$_ ] } @$pts ]
          : undef
          )
      } ;
    $res ;
  }

sub main # Xpaths
  { my $self = shift ;
    my $W    = shift ;
    my $args = $self -> args ;
    my $opts = $self -> opts ;
    my $MAX  = $opts -> {m} || 0 ;
    $self -> Xit ( $self -> usage ) unless @$args == 2 ;
    my $src = lc shift @$args ; $src = $W -> rootkid if $src eq 'root' ;
    my $dst = lc shift @$args ; $dst = $W -> rootkid if $dst eq 'root' ;
    if ( $opts -> {r} ) { my $tmp = $src ; $src = $dst ; $dst = $tmp ; }
    OBB -> Die ( "key $src too short" ) if length $src < 8 ;
    OBB -> Die ( "key $dst too short" ) if length $dst < 8 ;
    my $SRC = $W -> find_key ( $src ) or OBB -> Die ( "key $src not found" ) ;
    my $DST = $W -> find_key ( $dst ) or OBB -> Die ( "key $dst not found" ) ;
    my $res = $self -> json ( $W, $SRC, $DST, $MAX  ) ;
    if ( $opts -> {j} )
      { my $json = JSON::PP -> new -> pretty ( 1 ) -> canonical ( 1 ) ;
        printf "%s\n", $json -> encode ( $res ) ;
      }
    else
      { my $pts = $res -> {xpaths} ;
        my $Src = $SRC -> kid ;
        my $Dst = $DST -> kid ;
        print join "\n", map
          { ( @$_
            ? sprintf "%s\n", join "\n" , map
                { sprintf "%s %s", $_ -> {kid}, $_ -> {uid} ;
                } @$_
            : ( $Src eq $Dst ? 'src == dst' : "$Src signed $Dst" ) . "\n"
            ) ;
          } @$pts ;
      }
  }

###################################################################
package Wotsap::Cache ;
use base 'OBB' ;
__PACKAGE__ -> mk_getset ( qw(base days cdir) ) ;

sub Init
  { my $self = shift ;
    my %opts =
      ( days => 0
      , @_
      ) ;
    $self -> OBB::Init ( %opts ) ;
    my $cdir = $self -> base -> p_cdir ;
    $self -> cdir ( $cdir ) ;
    $self -> prep unless -d $cdir ;
    $self ;
  }

sub prep
  { my $self = shift ;
    my $cdir = $self -> cdir ;
    my @lst  = ( '0' .. '9', 'a' .. 'f' ) ;
    printf "prep [%s] ...\n", $cdir if $self -> Verbose ;
    for my $a ( @lst )
      { for my $b ( @lst )
          { for my $c ( @lst )
              { File::Path::mkpath ( "$cdir/$a/$b/$c", 0, 0755 ) ; }
          }
      }
    printf "prep [%s] done\n", $cdir if $self -> Verbose ;
  }

sub _pth
  { my $self = shift ;
    my $kid  = shift ;
    my $prf  = join '/', split '', substr $kid, 0, 3 ;
    sprintf '%s/%s/%s', $self -> cdir, $prf, $kid ;
  }

sub save
  { my $self = shift ;
    my $pth  = shift ;
    my $kid  = shift ;
    my $lnk  = $self -> _pth ( $kid ) ;
    OBB::TV ( "cache save  %s as %s\n", $pth, $lnk ) ;
    # shouldn't happen ; just to make sure
    $self -> Xit ( "cache save %s : %s not found", $kid, $pth )
      unless -f $pth ;
    $self -> Xit ( "cache save %s : %s is empty",  $kid, $pth )
      unless -s $pth ;
    unlink $lnk     ; # ignore errors
    link $pth, $lnk ; # ignore errors
  }

sub path
  { my $self = shift ;
    my $kid  = shift ;
    my $pth  = $self -> _pth ( $kid ) ;
    my $res  = ( -f $pth and -M $pth < $self -> days ) ? $pth : undef ;
    $res ;
  }

sub touch
  { my $self = shift ;
    my $kid  = shift ;
    my $pth  = $self -> _pth ( $kid ) ;
    my $res  = 0 ;
    OBB::TV ( "cache touch %s pth %s\n", $kid, $pth ) ;
    if ( -f $pth )
      { utime undef, undef, $pth or warn "can't touch $pth" ; $res = 1 ; }
    $res ;
  }

# Wotsap::Cache ;
sub get_key
  { my $self = shift ;
    my $kid  = shift ;
    my $pth  = $self -> path ( $kid ) ;
    my $res ;
    if ( $pth )
      { open PTH, '<', $pth or $self -> Xit ( "can't open $pth ($!)" ) ;
        my $blc = join '', <PTH> ;
        close PTH ;
        $res = Wotsap::Result -> Make
          ( kid => $kid, blc => $blc, pth => $pth, hit => 1 ) ;
      }
    OBB::TV ( "cache get   %s pth %s\n", $kid, $pth ) ;
    $res ;
  }

1 ;
__END__
=pod

=head1 NAME

  Wotsap.pm - unpack, use, pack a Wotsap (PGP strong set) archive

=head1 SYNOPSIS

  use Wotsap ;

  $W -> Wotsap -> Make ( path => "/path/to/workdir" )

  $key = $W -> key ( '8b962943fc243f3c' ) ;

  $key -> id  # some unique number
  $key -> kid # 8b962943fc243f3c
  $key -> uid # the key's primary uid ; some name

  @keys = $key -> has_signed
  @keys = $key -> signed_by

  @sigs = $key -> signatures
  $sig -> src # id of the signing key
  $sig -> dst # id of the signed key
  $sig -> lvl # the sig's trust level

  $keys = $W -> keys # table keys ; a Wotsap::Tab::Keys object
  $sigs = $W -> sigs # table sigs ; a Wotsap::Tab::Sigs object

  $dbh  = $W -> dbh # the DBI database handle for workdir's wotsap.lite
  @keys = $W -> keys -> select ( where => '...', ... )
  @sigs = $W -> sigs -> select ( where => '...', ... )

  $list = $W -> xpaths ( $a, $b ) # some paths from key $a to key $b

=head1 DESCRIPTION

The B<Wotsap.pm> module allows you to access a I<Wotsap archive>.
See L<http://pgp.cs.uu.nl/doc/> for a description of the Wotfile format.

A Wotsap archive is a densely packed file containing
historic information about the I<PGP strong set>.
For definitions, please see the section I<DEFINITIONS>.
In short : the I<PGP strong set> is a (maximal) set of PGP keys such that
for every two keys in the set, there is a trust path from each one
to the other.

Central to B<Wotsap.pm> is the notion of a I<Wotsap working directory>
(I<workdir> for short). A workdir is a just a directory containing
stuff pertaining to one Wotsap archive.

A workdir may contain the following files :

=over 4

=item * C<import.wot>

B<import.wot> is a wotsap archive, imported into the workdir.
It is a bzip2(1) compressed, ar(1) packed archive containing
some files (I<chunks> in wotsap parlance).

=item * the wotsap chunks

These files are extracted from B<import.wot> :

=over 4

=item * C<README>

A text file containing a short description of the wotsap archive.

=item * C<WOTVERSION>

A text file containing the wotsap version of B<import.wot>,
followed by a newline ; for instane "C<0.2\n>".

=item * C<keys>

A data file containing a list of coded key-id's,
one for each key in the strong set.

Wotsap versions 0.1 and 0.2 use 4 bytes (=> 8 hex digits)
per key ; version 0.3 uses 8 bytes (=> 16 hex digits).

=item * C<names>

A text file containing a list of I<names>.
The first name is the I<uid> of the first key in file C<keys> etc.

=item * C<signatures>

A data file containing lists of coded signatures.
The first list represents the signatures on the first key
in file C<keys> etc.

Each signature takes up 4 bytes ; the first 4 bits describe
the trust-level of the signature, the last 28 bits are an index
into the list of C<keys>.

In wotsap version 0.1, the lists are separated by a special marker.
In wotsap version 0.2 and 0.3, each list is preceded by a 4-byte count.

=item * C<debug> (optional)

A text file containing optional debug text.

=back

=item * C<keys.txt>

A text file, corresponding to file C<keys> ; each line contains
a decoded key-id : 8 hex digits for wotsap version 0.1 and 0.2 ;
16 hex digits for wotsap version 0.3.

=item * C<signatures.txt>

A text file, corresponding to file C<signatures> ; each line contains
1) a line number, 2) a list of signature descriptions B<I<idx>,I<lvl>>.

For example, line C<12 44177,6 39347,4> means that key #12 was signed by
key #44177 (with level 6) and key #39347 (with level 4).

=item * C<wotsap.lite>

C<wotsap.lite> is a L<sqlite|https://www.sqlite.org/> SQL database,
containing tables I<keys>, I<sigs> and I<meta> (meta information).

Basicly, table I<keys> holds one record per key. Columns :

=over 4

=item * id

some meaningless nummer, uniquely identifying a key.

=item * kid

the key's key-id ; a 8 or 16 hex-digit string.

=item * uid

the key's primary uid ; the name or mail-address of the key's owner.

=back

Table I<sigs> holds one record per signature. Columns :

=over 4

=item * src, dst

a reference to C<keys.id> ; meaning key I<src> signed key I<dst>.

=item * lvl

some trust-level associated with the signature ; see the
L<spec|http://pgp.cs.uu.nl/doc/>.

=back

The scheme (layout) of C<wotsap.lite> depends on the wotsap version
of C<import.wot> ; versions 0.1, 0.2 use 8 hex-digit key-id's,
and keys need not be unique ; version 0.3 uses unique, 16 digit key-ids.

If/when B<Wotsap.pm> is used to I<create> a new, fresh wotsap archive,
the schema of C<wotsap.lite> is augmented with some extra fields
(in table I<keys>) to facilitate the update and strong-set extraction
proces.

The I<db_type> (I<import> or I<export>) and
the I<version> (0.1, 0.2 or 0.3) of C<wotsap.lite>
are stored in table I<meta>.
At the moment, these attributes (if/when set) can not be changed.

=item * C<.sink>

=item * C<tmp>

Used for internal bookkeeping ; ignore.

=back

=head1 Wotsap class methods

=over 4

=item Make ( path => I<$path>, [ option -> value, ... ] )

Method C<Make> creates a workdir I<$path> (if it doesn't exist)
and/or stores option-values.

If I<$path> exists, method C<Make> checks that the specified
options are compatible with the stuff in workdir I<$path>.

I<Make> recognizes these options :

=over 4

=item version

The Wotsap version ; currently I<0.2> or I<0.3>.
The I<version> is usually set by the import of a wotsap archive.

=item db_type

The workdir I<type> ; currently I<import> or I<export>.
The I<db_type> is usually set by the import of a wotsap archive.

=item kserver

The fully qualified domain name of a PGP key-server.

=item prg_gpg

The path to gpg(1) ; default C</usr/bin/gpg>.

=back

=back

=head1 Wotsap instance methods

=over 4

=item get ( $id )

Method C<get> returns a Wotsap::Key object with the given I<id>,
or C<undef> if no such key can be found.

=item key ( $key_id )

Method C<key> returns a Wotsap::Key object with the given I<key_id>,
or C<undef> if no such key can be found.

=item find_key ( $key_id )

Method I<find_key> returns a Wotsap::Key object.

If I<$key_id> is longer than the C<Wotsap>'s key-length,
method C<find_key> uses a proper suffix of I<$key_id>.

If I<$key_id> is shorter than the C<Wotsap>'s key-length,
method C<find_key> returns any key that has I<$key_id> as a suffix
of it's key_id. Note : this search is very expensive.

Method C<find_key> returns C<undef> if no key can be found.

=item xpaths ( $a, $b [, $max] )

Method C<xpaths> searches for (atmost $max) paths
from C<Wotsap::Key> I<$a> to C<Wotsap::Key> I<$b>.

The result is a list of key-lists :

  [ [ key, ... ], ... ]

where each key-list is a path from I<$a> to I<$b>
with I<$a> and I<$b> omitted (the I<interior> of
a path from I<$a> to I<$b>).

If key I<$a> signed key I<$b>, the result is C<[[]]>.

If there are no paths from I<$a> to I<$b>, If the result is C<[]>.

If I<$a> or I<$b> is not defined, the result is C<undef>.

All paths are I<disjunct> (don't overlap).

=item path

The path of this C<Wotsap>'s workdir.

=item dbh

A database handle for this C<Wotsap>'s C<wotsap.lite>.

=item keys

A C<Wotsap::Keys> object, representing the database's I<keys> table.

=item sigs

A C<Wotsap::Sigs> object, representing the database's I<sigs> table.

=item version

The wotsap-version (0.1, 0.2 or 0.3) of this C<Wotsap> instance.

=item kid_len

The length (8 or 16) of key_id's in this C<Wotsap> instance.

=back

=head1 Wotsap::Tab

A C<Wotsap::Tab> object represents a database table.

C<Wotsap::Tab> is a stub for 

  Wotsap::Tab::Keys
  Wotsap::Tab::Sigs

=head2 Wotsap::Tab class methods

=over 4

=item row_pack

The result of method C<row_pack> is 'C<Wotsap::Rec>'.

This message I<should> be overridden in a subclass of C<Wotsap::Tab>.
That method must return the (name of the) package used
to create objects for rows of the subclass.

For instance :

  # package Wotsap::Tab::Keys ;
  sub row_pack { 'Wotsap::Key' ; }

=back

=head2 Wotsap::Tab instance methods

=over 4

=item name

The name of the sql-table.

=item base

A reference to the parent C<Wotsap> object.

=item select ( [option => ..., ...] )

Select tuples from a table ; with the options you can build a query.

The result is a list of objects. The class of the objects is
defined by the instance's attribute C<row_pack>.

For instance, a C<select> on a C<Wotsap::Tab::Keys> object,
results in a list of C<Wotsap::Key> objects.

Option defaults are shown as => ...

=over 4

=item cols => '*'

A comma-separated list of result columns.

=item from => ''

The sql I<from> clause. Use C<from> (and C<cols>)
if you want to do a I<join>.

=item where => '', group_by => '', having => '',
order_by => '', limit => ''

The usual clauses in an sql-select statement.

=item args => [ [] ]

Method C<select> creates an sql-statement-handle,
and then executes the select-statement once for
each element ($tup) of $args with

  $sth -> execute ( @$tup ) ;

When using DBI placeholders, call select with C<args> like :

  $W -> keys -> select ( where => "kid = ?", args => [ [$kid1], [$kid2] ] )

  $W -> sigs -> select
    ( where => "src = ? and dst = ?"
    , args =>
        [ [ $src1, $dst1 ]
        , [ $src2, $dst2 ]
        ]
    )

=item as_recs => 1

When set to I<0>, the result of the select is a list
of plain hashes.

=back

=item select1 ( [option => ..., ...] )

Same as select, except for this default :

  limit => 1

Method C<select1> returns the first record found,
or C<undef> if no record was found.

=item count ( [option => ..., ...] )

Same as select, except for these defaults :

  cols    => 'count(*) as _count_'
  limit   => 1
  as_recs => 0

Method C<count> returns C<_count_> of the first record found.

=back

=head1 Wotsap::Rec

A C<Wotsap::Rec> object represents a row is a database table.

C<Wotsap::Rec> is a stub for 

  Wotsap::Key
  Wotsap::Sig

=head2 Wotsap::Rec instance methods

=over 4

=item tabl

A reference to the parent C<Wotsap::Tab> object.

This expression yields the parent C<Wotsap> object of a record :

  $rec -> tabl -> base

=back

=head1 Wotsap::Key

A C<Wotsap::Key> object represents a key.

C<Wotsap::Key> is a subclass of C<Wotsap::Rec>.

=head2 Wotsap::Key instance methods

=over 4

=item id

Some meaningless, unique number.

=item kid

The key's kid ; a lowercase 8- or 16-hex-digit string.

=item uid

The key's (primary) uid.

=item has_signed

Returns a list of C<Wotsap::Key> objects ; the keys this key has signed.

=item signed_by

Returns a list of C<Wotsap::Key> objects ; the keys that signed this key.

=item signatures

Returns a list of C<Wotsap::Sig> objects ; the signatures on this key.

=back

=head1 Wotsap::Sig

A C<Wotsap::Sig> object represents a signature.

C<Wotsap::Sig> is a subclass of C<Wotsap::Rec>.

=head2 Wotsap::Sig instance methods

=over 4

=item src

  The id of the signing key.

=item dst

  The id of the signed key.

=item lvl

The sig's trust level ; a number between 0 and seven.
See the relevant specification for an interpretation.

In short, the last 2 bits represent the PGP check-level ;
the third least-significant bit indicates that the
signature was made on the key's primary uid.

  $sig -> lvl & 3 # check-level
  $sig -> lvl & 4 # sig on primary uid

=back

=head1 DEFINITIONS

=over 4

=item * the PGP graph

The set of PGP keys can be viewed as a directed graph,
where each key is a I<point>,
and each signature (with key I<a> signed key I<b>)
is an I<arrow> I<a> -> I<b>.

=item * PGP trust path

In a directed graph, a I<path> from I<a> to I<b> is a list of
points (I<a>, ..., I<b>) such that : I<a> -> ... -> I<b>.

A I<loop> (or I<x>-loop) is a path from I<x> to I<x>.

=item * strongly connected points

In a directed graph I<G>, two points I<a> and I<b> are I<strongly connected>
(I<a ~ b>) iff there is a path from I<a> to I<b> and a path from I<b> to I<a>.

Now relation I<~> is an
L<equivalence relation|https://en.wikipedia.org/wiki/Equivalence_relation>.
It naturally partitions the points of I<G> into equivalence classes :
maximal sets of equivalent points.

=item * I<strongly connected component>

A L<strongly connected component|http://en.wikipedia.org/wiki/Strongly_connected_component> (SCC)
of a directed graph I<G> is a (maximal) subgraph of I<G> such that
all points of SCC are strongly connected (in SCC).

This means that for every point in a SCC there is a path
to every other point in the SCC.

The SCC's of a directed graph do not overlap.
For a point I<x> in I<G>, the I<x>-SCC is the SCC containing I<x>.
The I<x>-SCC is the union of all I<x>-loops.

When we define, for some point I<root> :

  root-to-x = { x | there is a path from root to x }
  x-to-root = { x | there is a path from x to root }

then the I<root>-SCC is the intersection of I<root-to-x> and I<x-to-root>.
It can be found in linear time.

=item * I<PGP strong set>

In the L<PGP web of trust|https://en.wikipedia.org/wiki/Web_of_trust>,
the L<PGP strong set|https://en.wikipedia.org/wiki/Web_of_trust#Strong_set>
is (the) largest SCC of the PGP graph ;
in theory there could be more than one ; sofar, no prob.

B<Wotsap> computes the strong set as the I<root>-SCC for
some chosen I<root> ; by default B<8b962943fc243f3c>.

=back

=head1 CAVEAT

This page describes how to access an imported wotsap-archive.

This page doesn't (yet) document how to create and update a wotsap archive.

=head1 SEE ALSO

=for html <a href="wotsap.html">wotsap(1)</a>

=for man wotsap(1)

=head1 AUTHOR

=for html Wotsap &copy; 2015
<a href="http://www.staff.science.uu.nl/~penni101">Henk P. Penning</a>
- All rights reserved
; Wotsap-0.02.09 - Fri Aug 24 16:35:48 2018

=for man Wotsap by
Henk P. Penning, <http://www.staff.science.uu.nl/~penni101>.
- Wotsap-0.02.09 - Fri Aug 24 16:35:48 2018

You may distribute under the terms of either the GNU General Public
License or the Artistic License, as specified in the Perl 5.10.0 README
file.

=cut