#!/usr/bin/perl
# $RedRiver: keyring.cgi,v 1.4 2009/07/16 20:08:45 andrew Exp $
########################################################################
# keyring.cgi *** Update and modify keyring files
#
# 2009.06.10 #*#*# andrew fresh <andrew@cpan.org>
########################################################################
# Copyright 2009 Andrew Fresh, all rights reserved
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
########################################################################
use strict;
use warnings;

use feature 'state';

use CGI;
use File::Basename qw/ basename dirname /;
use File::Spec::Functions;

use CGI::Ajax;
use Palm::Keyring;
use Template;

my @path = '/users';
if ($ENV{'PATH_INFO'} && $ENV{'PATH_INFO'} ne '/') {
    push @path, $ENV{'PATH_INFO'};
}
elsif ( $ENV{'REMOTE_USER'} ) {
    push @path, $ENV{'REMOTE_USER'};
    # This is the users subdir;
    push @path, 'rings';
}
my $dir = catdir( @path );

my $query = CGI->new();
my $tt    = Template->new( { INCLUDE_PATH => catdir('../templates') } );
my $pjx   = new CGI::Ajax(
    changeFile     => \&change_file,
    changeCategory => \&change_category,
    changeRecord   => \&change_record,
);

#$pjx->JSDEBUG(1);
#$pjx->DEBUG(1);

my $password = $query->param('unlock_password');
my $file     = $query->param('file') || '';
my $category = $query->param('category');
my $record   = $query->param('record');

if ( $query->param('lock') ) {
    $password = undef;
}

$file = canonpath($file) if $file;
if ( $file =~ /^ \Q$path[0]\E /xms ) {
    $dir = dirname($file);
}

$dir = canonpath($dir) if $dir;
if ( $dir =~ m{/\.\.//}xms ) {
    error('Invalid Dir [$dir]');
    $dir = '';
}

files() if !$file;

if ( !$file ) {
    error("No Keyrings in [$dir]!");
}

if ( $dir && $file ) {
    $file = catfile( $dir, basename($file) );
    error("Dir [$dir] does not exist!")   if !-d $dir;
    error("File [$file] does not exist!") if !-e $file;
}

print $pjx->build_html( $query, \&Show_HTML );

#print $query->header(), Show_HTML();

sub Show_HTML {
    my $output = '';

    $tt->process(
        'index.tt2',
        {   title      => 'Palm Keyring for the web',
            passwords  => \&password,
            files      => \&files,
            categories => \&categories,
            lists      => \&list,
            records    => \&record,
            errors     => \&error,
        },
        \$output
    ) || die $tt->error(), "\n";

    return $output;
}

sub error {
    state $error;

    if (@_) {
        my $last_error = $error;
        $error = join q{ }, @_;
        return $last_error;
    }

    return $error;
}

sub password {
    my $message = '';
    if ($password) {
        my $pdb = open_pdb();
        my $valid = eval { $pdb->Password($password) };
        if ($@) {
            error($@);
	    $message = "Error: $@";
        }
        elsif ($valid) {
            return
                  'Unlocked: '
                . $query->hidden( 'unlock_password', $password )
                . $query->submit( -name => 'lock', -value => 'Lock', );
        }
        else {
            $message = "$message<br>Invalid Password";
        }
    }

    return 'Locked - Enter Password to Unlock: ' . $query->br() 
	. $message . $query->password_field(
            -name     => 'unlock_password',
            -value    => '',
            -override => 1,
        );
}

sub files {
    my @keyrings;
    if ( -d $dir ) {
        opendir( my $dh, $dir ) || die "Couldn't opendir $dir: $!";
        @keyrings = grep {/^Keys.*\.(?i:pdb)$/xms} readdir $dh;
        closedir $dh;
    }

    my $output = '';
    if (@keyrings) {
        $file ||= $dir . '/' . $keyrings[0];
        if ( @keyrings > 1 ) {
            $output = $query->popup_menu(
                -name     => 'file',
                -values   => [ map { $dir . '/' . $_ } @keyrings ],
                -labels   => { map { $dir . '/' . $_ => $_ } @keyrings },
                -default  => $file,
                -onChange => "changeFile("
                    . "['file'],"
                    . "['unlock_passwords','files','categories','lists','records','errors']);",
            );
        }
        else {
            $output = basename($file) . $query->hidden( 'file', $file );
        }
    }
    return $output;
}

sub categories {
    my $pdb = open_pdb() || return;

    my %categories;
    foreach my $id ( 0 .. $#{ $pdb->{'appinfo'}->{'categories'} } ) {
        my $c = $pdb->{'appinfo'}->{'categories'}->[$id];
        $categories{$id} = $c->{name} if $c->{name};
    }

    return unless %categories;
    $categories{-1} = 'All';
    $category //= -1;
    if ( !exists $categories{$category} ) {
        $category = -1;
    }

    return $query->popup_menu(
        -name     => 'category',
        -values   => [ 
            sort { lc( $categories{$a} ) cmp lc( $categories{$b} ) } 
            	keys %categories 
        ],
        -default  => $category,
        -labels   => \%categories,
        -onChange => "changeCategory("
            . "['unlock_password','file','category'],"
            . "['lists','errors'], 'POST');",
    );
}

sub list {
    my $pdb = open_pdb() || return;

    my %records;
    foreach my $id ( 0 .. $#{ $pdb->{records} } ) {
        my $r = $pdb->{records}->[$id];

        if ( defined $category && $category >= 0 ) {
            next if $category != $r->{category};
        }

        my $data = $r->{plaintext}->{0}->{data};
        $records{$id} = defined $data ? $data : $id;
    }

    return $query->scrolling_list(
        -name   => 'record',
        -values => [
            sort { lc( $records{$a} ) cmp lc( $records{$b} ) } keys %records
        ],
        -default  => [$record],
        -labels   => \%records,
        -onChange => "changeRecord("
            . "['unlock_password','file','record'],"
            . "['records','errors'], 'POST');",
    );
}

sub record {
    my $pdb = open_pdb();

    my %acct = (
        category   => { order => -1 },
        name       => { order => 0 },
        account    => { order => 1 },
        password   => { order => 2 },
        lastchange => { order => 3 },
        notes      => { order => 255 },
    );

    if ( $pdb && defined $record ) {
        my $r = $pdb->{records}->[$record];

        my $a = $r->{plaintext};
        if ($password) {
            eval { $a = $pdb->Decrypt( $r, $password ) };
            if ($@) {
                error($@);
            }
        }

        foreach my $id ( keys %{$a} ) {
            my $label = $a->{$id}->{label};
            $acct{$label} = $a->{$id};
            $acct{$label}{order} = $id;

            if ( $label eq 'lastchange' ) {
                my $d = $acct{$label}{data};
                $acct{$label}{data} = sprintf "%04d/%02d/%02d",
                    $d->{year} + 1900,
                    $d->{month} + 1,
                    $d->{day};
            }

        }

        $acct{category} = {
            order => -1,
            data => $pdb->{appinfo}->{categories}->[ $r->{category} ]->{name},
        };
    }

    my $output;
    foreach
        my $key ( sort { $acct{$a}{order} <=> $acct{$b}{order} } keys %acct )
    {
        my $label = ucfirst($key);
        if ( $key eq 'lastchange' ) {
            $label = 'Last Change';
        }

        my $type = 'textfield';
        if ($key eq 'notes') {
            $type = 'textarea';
        }

        $output 
            .= $label . ': ' .
            #$acct{$key}{data} .
            $query->$type(
            -name     => 'acct_' . $key,
            -value    => $acct{$key}{data},
            -override => 1,
            ) . 
            $query->br;
    }

    return $output;
}

sub open_pdb {
    return if ( !$file );
    state $pdb;
    state $last_file = '';

    if ( $pdb && $file eq $last_file ) {
        return $pdb;
    }

    eval { $pdb = new Palm::PDB() };
    if ($@) {
        warn $@;
        error($@);
        return;
    }

    eval { $pdb->Load($file) };
    if ($@) {
        warn $@;
        error($@);
        return;
    }

    return $pdb;
}

sub change_file {
    ($file) = @_;
    $password = undef;

    return password(), files(), categories(), list(), record(), error();
}

sub change_category {
    ( $password, $file, $category ) = @_;

    return list(), error();
}

sub change_record {
    ( $password, $file, $record ) = @_;

    return record(), error();
}