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