Annotation of palm/Palm-Keyring/examples/cgi/bin/keyring.cgi, Revision 1.5
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 {
116: if ($password) {
117: my $pdb = open_pdb();
118: eval { $pdb->Password($password) };
119: if ($@) {
120: error($@);
121: }
122: else {
123: return
124: 'Unlocked: '
1.3 andrew 125: . $query->hidden( 'unlock_password', $password )
1.1 andrew 126: . $query->submit( -name => 'lock', -value => 'Lock', );
127: }
128: }
129:
1.3 andrew 130: return 'Locked - Enter Password to Unlock: ' . $query->br()
1.1 andrew 131: . $query->password_field(
1.3 andrew 132: -name => 'unlock_password',
1.1 andrew 133: -value => '',
134: -override => 1,
135: );
136: }
137:
138: sub files {
139: my @keyrings;
140: if ( -d $dir ) {
141: opendir( my $dh, $dir ) || die "Couldn't opendir $dir: $!";
142: @keyrings = grep {/^Keys.*\.(?i:pdb)$/xms} readdir $dh;
143: closedir $dh;
144: }
145:
146: my $output = '';
147: if (@keyrings) {
148: $file ||= $dir . '/' . $keyrings[0];
149: if ( @keyrings > 1 ) {
150: $output = $query->popup_menu(
151: -name => 'file',
152: -values => [ map { $dir . '/' . $_ } @keyrings ],
153: -labels => { map { $dir . '/' . $_ => $_ } @keyrings },
154: -default => $file,
155: -onChange => "changeFile("
156: . "['file'],"
1.3 andrew 157: . "['unlock_passwords','files','categories','lists','records','errors']);",
1.1 andrew 158: );
159: }
160: else {
161: $output = basename($file) . $query->hidden( 'file', $file );
162: }
163: }
164: return $output;
165: }
166:
167: sub categories {
168: my $pdb = open_pdb() || return;
169:
170: my %categories;
171: foreach my $id ( 0 .. $#{ $pdb->{'appinfo'}->{'categories'} } ) {
172: my $c = $pdb->{'appinfo'}->{'categories'}->[$id];
173: $categories{$id} = $c->{name} if $c->{name};
174: }
175:
176: return unless %categories;
177: $categories{-1} = 'All';
178: $category //= -1;
179: if ( !exists $categories{$category} ) {
180: $category = -1;
181: }
182:
183: return $query->popup_menu(
184: -name => 'category',
1.4 andrew 185: -values => [
186: sort { lc( $categories{$a} ) cmp lc( $categories{$b} ) }
187: keys %categories
188: ],
1.1 andrew 189: -default => $category,
190: -labels => \%categories,
191: -onChange => "changeCategory("
1.3 andrew 192: . "['unlock_password','file','category'],"
1.1 andrew 193: . "['lists','errors'], 'POST');",
194: );
195: }
196:
197: sub list {
198: my $pdb = open_pdb() || return;
199:
200: my %records;
201: foreach my $id ( 0 .. $#{ $pdb->{records} } ) {
202: my $r = $pdb->{records}->[$id];
203:
204: if ( defined $category && $category >= 0 ) {
205: next if $category != $r->{category};
206: }
207:
208: my $data = $r->{plaintext}->{0}->{data};
209: $records{$id} = defined $data ? $data : $id;
210: }
211:
212: return $query->scrolling_list(
213: -name => 'record',
214: -values => [
215: sort { lc( $records{$a} ) cmp lc( $records{$b} ) } keys %records
216: ],
217: -default => [$record],
218: -labels => \%records,
219: -onChange => "changeRecord("
1.3 andrew 220: . "['unlock_password','file','record'],"
1.1 andrew 221: . "['records','errors'], 'POST');",
222: );
223: }
224:
225: sub record {
226: my $pdb = open_pdb();
227:
228: my %acct = (
229: category => { order => -1 },
230: name => { order => 0 },
231: account => { order => 1 },
232: password => { order => 2 },
233: lastchange => { order => 3 },
234: notes => { order => 255 },
235: );
236:
237: if ( $pdb && defined $record ) {
238: my $r = $pdb->{records}->[$record];
239:
240: my $a = $r->{plaintext};
241: if ($password) {
242: eval { $a = $pdb->Decrypt( $r, $password ) };
243: if ($@) {
244: error($@);
245: }
246: }
247:
248: foreach my $id ( keys %{$a} ) {
249: my $label = $a->{$id}->{label};
250: $acct{$label} = $a->{$id};
251: $acct{$label}{order} = $id;
252:
253: if ( $label eq 'lastchange' ) {
254: my $d = $acct{$label}{data};
255: $acct{$label}{data} = sprintf "%04d/%02d/%02d",
256: $d->{year} + 1900,
1.5 ! andrew 257: $d->{month} + 1,
1.1 andrew 258: $d->{day};
259: }
260:
261: }
262:
263: $acct{category} = {
264: order => -1,
265: data => $pdb->{appinfo}->{categories}->[ $r->{category} ]->{name},
266: };
267: }
268:
269: my $output;
270: foreach
271: my $key ( sort { $acct{$a}{order} <=> $acct{$b}{order} } keys %acct )
272: {
273: my $label = ucfirst($key);
274: if ( $key eq 'lastchange' ) {
275: $label = 'Last Change';
276: }
277:
1.3 andrew 278: my $type = 'textfield';
279: if ($key eq 'notes') {
280: $type = 'textarea';
281: }
282:
1.1 andrew 283: $output
1.5 ! andrew 284: .= $label . ': ' .
! 285: #$acct{$key}{data} .
! 286: $query->$type(
1.1 andrew 287: -name => 'acct_' . $key,
288: -value => $acct{$key}{data},
289: -override => 1,
1.5 ! andrew 290: ) .
! 291: $query->br;
1.1 andrew 292: }
293:
294: return $output;
295: }
296:
297: sub open_pdb {
298: return if ( !$file );
299: state $pdb;
300: state $last_file = '';
301:
302: if ( $pdb && $file eq $last_file ) {
303: return $pdb;
304: }
305:
306: eval { $pdb = new Palm::PDB() };
307: if ($@) {
308: warn $@;
309: error($@);
310: return;
311: }
312:
313: eval { $pdb->Load($file) };
314: if ($@) {
315: warn $@;
316: error($@);
317: return;
318: }
319:
320: return $pdb;
321: }
322:
323: sub change_file {
324: ($file) = @_;
325: $password = undef;
326:
327: return password(), files(), categories(), list(), record(), error();
328: }
329:
330: sub change_category {
331: ( $password, $file, $category ) = @_;
332:
333: return list(), error();
334: }
335:
336: sub change_record {
337: ( $password, $file, $record ) = @_;
338:
339: return record(), error();
340: }
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