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