Annotation of palm/Palm-Keyring/examples/cgi/bin/keyring.cgi, Revision 1.1
1.1 ! andrew 1: #!/usr/bin/perl
! 2: # $RedRiver$
! 3: ########################################################################
! 4: # keyring.cgi *** Update and modify keyring files
! 5: #
! 6: # 2009.06.10 #*#*# andrew fresh <andrew@cpan.org>
! 7: ########################################################################
! 8: # Copyright 2009 Andrew Fresh, all rights reserved
! 9: #
! 10: # This program is free software; you can redistribute it and/or modify
! 11: # it under the same terms as Perl itself.
! 12: ########################################################################
! 13: use strict;
! 14: use warnings;
! 15:
! 16: use Data::Dumper;
! 17:
! 18: use feature 'state';
! 19:
! 20: use CGI;
! 21: use File::Basename qw/ basename dirname /;
! 22: use File::Spec::Functions;
! 23:
! 24: use CGI::Ajax;
! 25: use Palm::Keyring;
! 26: use Template;
! 27:
! 28: my $base_path = '/keyring';
! 29: my $keyring_path = catdir($base_path, 'rings');
! 30: my $dir = $ENV{'PATH_INFO'} || '/';
! 31:
! 32: my $query = CGI->new();
! 33: my $tt
! 34: = Template->new( { INCLUDE_PATH => catdir( $base_path, 'templates' ) } );
! 35: my $pjx = new CGI::Ajax(
! 36: changeFile => \&change_file,
! 37: changeCategory => \&change_category,
! 38: changeRecord => \&change_record,
! 39: );
! 40:
! 41: #$pjx->JSDEBUG(1);
! 42: #$pjx->DEBUG(1);
! 43:
! 44: my $password = $query->param('password');
! 45: my $file = $query->param('file') || '';
! 46: my $category = $query->param('category');
! 47: my $record = $query->param('record');
! 48:
! 49: if ( $query->param('lock') ) {
! 50: $password = undef;
! 51: }
! 52:
! 53: $file = canonpath($file) if $file;
! 54:
! 55: if ( $file =~ /^ \Q$keyring_path\E /xms ) {
! 56: $dir = dirname($file);
! 57: }
! 58: else {
! 59: $dir = catdir( $keyring_path, $dir );
! 60:
! 61: files() if !$file;
! 62:
! 63: if ( !$file ) {
! 64: error("no file in [$dir]!");
! 65: }
! 66:
! 67: if ( $dir && $file ) {
! 68: if ( !-d $dir ) {
! 69: error("Path [$dir] does not exist!");
! 70: }
! 71: $file = catfile( $dir, basename($file) );
! 72: }
! 73: }
! 74:
! 75: print $pjx->build_html( $query, \&Show_HTML );
! 76: #print $query->header(), Show_HTML();
! 77:
! 78: sub Show_HTML {
! 79: my $output = '';
! 80:
! 81: $tt->process(
! 82: 'index.tt2',
! 83: { title => 'Palm Keyring for the web',
! 84: passwords => \&password,
! 85: files => \&files,
! 86: categories => \&categories,
! 87: lists => \&list,
! 88: records => \&record,
! 89: errors => \&error,
! 90: },
! 91: \$output
! 92: ) || die $tt->error(), "\n";
! 93:
! 94: return $output;
! 95: }
! 96:
! 97: sub error {
! 98: state $error;
! 99:
! 100: if (@_) {
! 101: my $last_error = $error;
! 102: $error = join q{ }, @_;
! 103: return $last_error;
! 104: }
! 105:
! 106: return $error;
! 107: }
! 108:
! 109: sub password {
! 110: if ($password) {
! 111: my $pdb = open_pdb();
! 112: eval { $pdb->Password($password) };
! 113: if ($@) {
! 114: error($@);
! 115: }
! 116: else {
! 117: return
! 118: 'Unlocked: '
! 119: . $query->hidden( 'password', $password )
! 120: . $query->submit( -name => 'lock', -value => 'Lock', );
! 121: }
! 122: }
! 123:
! 124: return 'Password: '
! 125: . $query->password_field(
! 126: -name => 'password',
! 127: -value => '',
! 128: -override => 1,
! 129: );
! 130: }
! 131:
! 132: sub files {
! 133: my @keyrings;
! 134: if ( -d $dir ) {
! 135: opendir( my $dh, $dir ) || die "Couldn't opendir $dir: $!";
! 136: @keyrings = grep {/^Keys.*\.(?i:pdb)$/xms} readdir $dh;
! 137: closedir $dh;
! 138: }
! 139:
! 140: my $output = '';
! 141: if (@keyrings) {
! 142: $file ||= $dir . '/' . $keyrings[0];
! 143: if ( @keyrings > 1 ) {
! 144: $output = $query->popup_menu(
! 145: -name => 'file',
! 146: -values => [ map { $dir . '/' . $_ } @keyrings ],
! 147: -labels => { map { $dir . '/' . $_ => $_ } @keyrings },
! 148: -default => $file,
! 149: -onChange => "changeFile("
! 150: . "['file'],"
! 151: . "['passwords','files','categories','lists','records','errors']);",
! 152: );
! 153: }
! 154: else {
! 155: $output = basename($file) . $query->hidden( 'file', $file );
! 156: }
! 157: }
! 158: return $output;
! 159: }
! 160:
! 161: sub categories {
! 162: my $pdb = open_pdb() || return;
! 163:
! 164: my %categories;
! 165: foreach my $id ( 0 .. $#{ $pdb->{'appinfo'}->{'categories'} } ) {
! 166: my $c = $pdb->{'appinfo'}->{'categories'}->[$id];
! 167: $categories{$id} = $c->{name} if $c->{name};
! 168: }
! 169:
! 170: return unless %categories;
! 171: $categories{-1} = 'All';
! 172: $category //= -1;
! 173: if ( !exists $categories{$category} ) {
! 174: $category = -1;
! 175: }
! 176:
! 177: return $query->popup_menu(
! 178: -name => 'category',
! 179: -values => [ sort { $a <=> $b } keys %categories ],
! 180: -default => $category,
! 181: -labels => \%categories,
! 182: -onChange => "changeCategory("
! 183: . "['password','file','category'],"
! 184: . "['lists','errors'], 'POST');",
! 185: );
! 186: }
! 187:
! 188: sub list {
! 189: my $pdb = open_pdb() || return;
! 190:
! 191: my %records;
! 192: foreach my $id ( 0 .. $#{ $pdb->{records} } ) {
! 193: my $r = $pdb->{records}->[$id];
! 194:
! 195: if ( defined $category && $category >= 0 ) {
! 196: next if $category != $r->{category};
! 197: }
! 198:
! 199: my $data = $r->{plaintext}->{0}->{data};
! 200: $records{$id} = defined $data ? $data : $id;
! 201: }
! 202:
! 203: return $query->scrolling_list(
! 204: -name => 'record',
! 205: -values => [
! 206: sort { lc( $records{$a} ) cmp lc( $records{$b} ) } keys %records
! 207: ],
! 208: -default => [$record],
! 209: -labels => \%records,
! 210: -size => 25,
! 211: -onChange => "changeRecord("
! 212: . "['password','file','record'],"
! 213: . "['records','errors'], 'POST');",
! 214: );
! 215: }
! 216:
! 217: sub record {
! 218: my $pdb = open_pdb();
! 219:
! 220: my %acct = (
! 221: category => { order => -1 },
! 222: name => { order => 0 },
! 223: account => { order => 1 },
! 224: password => { order => 2 },
! 225: lastchange => { order => 3 },
! 226: notes => { order => 255 },
! 227: );
! 228:
! 229: if ( $pdb && defined $record ) {
! 230: my $r = $pdb->{records}->[$record];
! 231:
! 232: my $a = $r->{plaintext};
! 233: if ($password) {
! 234: eval { $a = $pdb->Decrypt( $r, $password ) };
! 235: if ($@) {
! 236: error($@);
! 237: }
! 238: }
! 239:
! 240: foreach my $id ( keys %{$a} ) {
! 241: my $label = $a->{$id}->{label};
! 242: $acct{$label} = $a->{$id};
! 243: $acct{$label}{order} = $id;
! 244:
! 245: if ( $label eq 'lastchange' ) {
! 246: my $d = $acct{$label}{data};
! 247: $acct{$label}{data} = sprintf "%04d/%02d/%02d",
! 248: $d->{year} + 1900,
! 249: $d->{month},
! 250: $d->{day};
! 251: }
! 252:
! 253: }
! 254:
! 255: $acct{category} = {
! 256: order => -1,
! 257: data => $pdb->{appinfo}->{categories}->[ $r->{category} ]->{name},
! 258: };
! 259: }
! 260:
! 261: my $output;
! 262: foreach
! 263: my $key ( sort { $acct{$a}{order} <=> $acct{$b}{order} } keys %acct )
! 264: {
! 265: my $label = ucfirst($key);
! 266: if ( $key eq 'lastchange' ) {
! 267: $label = 'Last Change';
! 268: }
! 269:
! 270: $output
! 271: .= $label . ': '
! 272: . $query->textfield(
! 273: -name => 'acct_' . $key,
! 274: -value => $acct{$key}{data},
! 275: -override => 1,
! 276: ) . $query->br;
! 277: }
! 278:
! 279: return $output;
! 280: }
! 281:
! 282: sub open_pdb {
! 283: return if ( !$file );
! 284: state $pdb;
! 285: state $last_file = '';
! 286:
! 287: if ( $pdb && $file eq $last_file ) {
! 288: return $pdb;
! 289: }
! 290:
! 291: eval { $pdb = new Palm::PDB() };
! 292: if ($@) {
! 293: warn $@;
! 294: error($@);
! 295: return;
! 296: }
! 297:
! 298: eval { $pdb->Load($file) };
! 299: if ($@) {
! 300: warn $@;
! 301: error($@);
! 302: return;
! 303: }
! 304:
! 305: return $pdb;
! 306: }
! 307:
! 308: sub change_file {
! 309: ($file) = @_;
! 310: $password = undef;
! 311:
! 312: return password(), files(), categories(), list(), record(), error();
! 313: }
! 314:
! 315: sub change_category {
! 316: ( $password, $file, $category ) = @_;
! 317:
! 318: return list(), error();
! 319: }
! 320:
! 321: sub change_record {
! 322: ( $password, $file, $record ) = @_;
! 323:
! 324: return record(), error();
! 325: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to keyring.cgi CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / palm / Palm-Keyring / examples / cgi / bin