Annotation of palm/Palm-Keyring/examples/cgi/bin/keyring.cgi, Revision 1.4
1.1 andrew 1: #!/usr/bin/perl
1.4 ! andrew 2: # $RedRiver: keyring.cgi,v 1.3 2009/06/16 01:39:09 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',
1.4 ! andrew 183: -values => [
! 184: sort { lc( $categories{$a} ) cmp lc( $categories{$b} ) }
! 185: keys %categories
! 186: ],
1.1 andrew 187: -default => $category,
188: -labels => \%categories,
189: -onChange => "changeCategory("
1.3 andrew 190: . "['unlock_password','file','category'],"
1.1 andrew 191: . "['lists','errors'], 'POST');",
192: );
193: }
194:
195: sub list {
196: my $pdb = open_pdb() || return;
197:
198: my %records;
199: foreach my $id ( 0 .. $#{ $pdb->{records} } ) {
200: my $r = $pdb->{records}->[$id];
201:
202: if ( defined $category && $category >= 0 ) {
203: next if $category != $r->{category};
204: }
205:
206: my $data = $r->{plaintext}->{0}->{data};
207: $records{$id} = defined $data ? $data : $id;
208: }
209:
210: return $query->scrolling_list(
211: -name => 'record',
212: -values => [
213: sort { lc( $records{$a} ) cmp lc( $records{$b} ) } keys %records
214: ],
215: -default => [$record],
216: -labels => \%records,
217: -onChange => "changeRecord("
1.3 andrew 218: . "['unlock_password','file','record'],"
1.1 andrew 219: . "['records','errors'], 'POST');",
220: );
221: }
222:
223: sub record {
224: my $pdb = open_pdb();
225:
226: my %acct = (
227: category => { order => -1 },
228: name => { order => 0 },
229: account => { order => 1 },
230: password => { order => 2 },
231: lastchange => { order => 3 },
232: notes => { order => 255 },
233: );
234:
235: if ( $pdb && defined $record ) {
236: my $r = $pdb->{records}->[$record];
237:
238: my $a = $r->{plaintext};
239: if ($password) {
240: eval { $a = $pdb->Decrypt( $r, $password ) };
241: if ($@) {
242: error($@);
243: }
244: }
245:
246: foreach my $id ( keys %{$a} ) {
247: my $label = $a->{$id}->{label};
248: $acct{$label} = $a->{$id};
249: $acct{$label}{order} = $id;
250:
251: if ( $label eq 'lastchange' ) {
252: my $d = $acct{$label}{data};
253: $acct{$label}{data} = sprintf "%04d/%02d/%02d",
254: $d->{year} + 1900,
255: $d->{month},
256: $d->{day};
257: }
258:
259: }
260:
261: $acct{category} = {
262: order => -1,
263: data => $pdb->{appinfo}->{categories}->[ $r->{category} ]->{name},
264: };
265: }
266:
267: my $output;
268: foreach
269: my $key ( sort { $acct{$a}{order} <=> $acct{$b}{order} } keys %acct )
270: {
271: my $label = ucfirst($key);
272: if ( $key eq 'lastchange' ) {
273: $label = 'Last Change';
274: }
275:
1.3 andrew 276: my $type = 'textfield';
277: if ($key eq 'notes') {
278: $type = 'textarea';
279: }
280:
1.1 andrew 281: $output
282: .= $label . ': '
1.3 andrew 283: . $query->$type(
1.1 andrew 284: -name => 'acct_' . $key,
285: -value => $acct{$key}{data},
286: -override => 1,
287: ) . $query->br;
288: }
289:
290: return $output;
291: }
292:
293: sub open_pdb {
294: return if ( !$file );
295: state $pdb;
296: state $last_file = '';
297:
298: if ( $pdb && $file eq $last_file ) {
299: return $pdb;
300: }
301:
302: eval { $pdb = new Palm::PDB() };
303: if ($@) {
304: warn $@;
305: error($@);
306: return;
307: }
308:
309: eval { $pdb->Load($file) };
310: if ($@) {
311: warn $@;
312: error($@);
313: return;
314: }
315:
316: return $pdb;
317: }
318:
319: sub change_file {
320: ($file) = @_;
321: $password = undef;
322:
323: return password(), files(), categories(), list(), record(), error();
324: }
325:
326: sub change_category {
327: ( $password, $file, $category ) = @_;
328:
329: return list(), error();
330: }
331:
332: sub change_record {
333: ( $password, $file, $record ) = @_;
334:
335: return record(), error();
336: }
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