![[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|
Return to keyring.cgi CVS log | Up to [local] / palm / Palm-Keyring / examples / cgi / bin |
1.1 andrew 1: #!/usr/bin/perl
1.2 ! andrew 2: # $RedRiver: keyring.cgi,v 1.1 2009/06/11 20:40: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 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:
42: my $password = $query->param('password');
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: '
123: . $query->hidden( 'password', $password )
124: . $query->submit( -name => 'lock', -value => 'Lock', );
125: }
126: }
127:
128: return 'Password: '
129: . $query->password_field(
130: -name => 'password',
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'],"
155: . "['passwords','files','categories','lists','records','errors']);",
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("
187: . "['password','file','category'],"
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: -size => 25,
215: -onChange => "changeRecord("
216: . "['password','file','record'],"
217: . "['records','errors'], 'POST');",
218: );
219: }
220:
221: sub record {
222: my $pdb = open_pdb();
223:
224: my %acct = (
225: category => { order => -1 },
226: name => { order => 0 },
227: account => { order => 1 },
228: password => { order => 2 },
229: lastchange => { order => 3 },
230: notes => { order => 255 },
231: );
232:
233: if ( $pdb && defined $record ) {
234: my $r = $pdb->{records}->[$record];
235:
236: my $a = $r->{plaintext};
237: if ($password) {
238: eval { $a = $pdb->Decrypt( $r, $password ) };
239: if ($@) {
240: error($@);
241: }
242: }
243:
244: foreach my $id ( keys %{$a} ) {
245: my $label = $a->{$id}->{label};
246: $acct{$label} = $a->{$id};
247: $acct{$label}{order} = $id;
248:
249: if ( $label eq 'lastchange' ) {
250: my $d = $acct{$label}{data};
251: $acct{$label}{data} = sprintf "%04d/%02d/%02d",
252: $d->{year} + 1900,
253: $d->{month},
254: $d->{day};
255: }
256:
257: }
258:
259: $acct{category} = {
260: order => -1,
261: data => $pdb->{appinfo}->{categories}->[ $r->{category} ]->{name},
262: };
263: }
264:
265: my $output;
266: foreach
267: my $key ( sort { $acct{$a}{order} <=> $acct{$b}{order} } keys %acct )
268: {
269: my $label = ucfirst($key);
270: if ( $key eq 'lastchange' ) {
271: $label = 'Last Change';
272: }
273:
274: $output
275: .= $label . ': '
276: . $query->textfield(
277: -name => 'acct_' . $key,
278: -value => $acct{$key}{data},
279: -override => 1,
280: ) . $query->br;
281: }
282:
283: return $output;
284: }
285:
286: sub open_pdb {
287: return if ( !$file );
288: state $pdb;
289: state $last_file = '';
290:
291: if ( $pdb && $file eq $last_file ) {
292: return $pdb;
293: }
294:
295: eval { $pdb = new Palm::PDB() };
296: if ($@) {
297: warn $@;
298: error($@);
299: return;
300: }
301:
302: eval { $pdb->Load($file) };
303: if ($@) {
304: warn $@;
305: error($@);
306: return;
307: }
308:
309: return $pdb;
310: }
311:
312: sub change_file {
313: ($file) = @_;
314: $password = undef;
315:
316: return password(), files(), categories(), list(), record(), error();
317: }
318:
319: sub change_category {
320: ( $password, $file, $category ) = @_;
321:
322: return list(), error();
323: }
324:
325: sub change_record {
326: ( $password, $file, $record ) = @_;
327:
328: return record(), error();
329: }