$Tk::LockDisplay::VERSION = '1.3';

package Tk::LockDisplay;

# An xlock-like dialog that requires authentication before unlocking the display.
#
# Stephen.O.Lidie@Lehigh.EDU, Lehigh University Computing Center.  98/08/12
#
# This program is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.

use 5.004;
use Carp;
use Tk::Toplevel;
use strict;
use base qw/Tk::Derived Tk::Toplevel/;
Construct Tk::Widget 'LockDisplay';

sub Lock {

    # Realize the dialog, start the screensaver and snooze timer events, clear the password entry, save the current
    # focus and grab and set ours, raise the dialog and wait for the password, release our grab, clear timers, hide
    # the dialog and restore the original focus and grab.  Whew.  (Of course, no timer stuff unless we're animating.)

    my($self) = @_;
    
    my $mez = $self->{Configure}{-animation};
    unless ($mez eq 'none') {
	$self->{mid} = $self->repeat($self->{Configure}{-animationinterval} => [$self => 'mesmerize']);
	$self->{tid} = $self->after($self->{Configure}{-hide} * 1000  => [$self => 'snooze']);
    }
    $self->deiconify;
    $self->waitVisibility;
    $self->{entry}->delete(0 => 'end');
    my $old_focus = $self->focusSave;
    my $old_grab  = $self->grabSave;
    $self->{entry}->focusForce;
    $self->grab(-global);
    $self->raise;
    $self->waitVariable(\$self->{unlock});
    $self->grabRelease;
    unless ($mez eq 'none') {
	$self->afterCancel($self->{tid});
	$self->afterCancel($self->{mid});
    }
    $self->withdraw;
    &$old_focus;
    &$old_grab;

} # end Lock

sub Populate {

    # LockDisplay constructor.  These are the composite widget instance keys:
    #
    # -authenticate => authentication subroutine
    # user          => username
    # pw            => password
    # unlock        => modified when user properly authenticates
    #
    # w             => display width, pixels
    # h             => display height, pixels
    # canvas        => canvas widget reference
    # label         => label widget reference
    # entry         => entry widget reference
    #
    # tid           => -hide after() timer id
    # mid           => -animationinterval repeat() id
    #
    # plug_init     => 1 IFF plugin initialized
    # -debug        => 1 IFF <Double-1> can unlock display

    my($cw, $args) = @_;

    # Disable interactions with the window manager.
    
    $cw->withdraw;
    $cw->protocol('WM_DELETE_WINDOW' => sub {});
    $cw->overrideredirect(1);

    # Process arguments.

    my $user;
    if (not $user = getlogin) {
        if ($^O eq 'MSWin32') {
            $user = $^O;
        } else {
            die "Can't get user name." if not $user = getpwuid($<);
        }
    }
    $cw->{user} = $user;
    $cw->{-authenticate} = delete $args->{-authenticate};
    die "-authenticate callback is improper or missing." unless ref($cw->{-authenticate}) eq 'CODE';
    $cw->{-debug} = delete $args->{-debug};
    $cw->{-debug} ||= 0;
    $args->{-animation} ||= 'lines';
    $cw->SUPER::Populate($args);
    
    # Miscellaneous constants.

    my($w, $h) = ($cw->screenwidth, $cw->screenheight);
    $cw->{w} = $w;
    $cw->{h} = $h;
    my $ti = "tklock $Tk::LockDisplay::VERSION";

    # The canvas/label/entry, et.al.
    
    my $mez = $args->{-animation};
    my $pw;
    $cw->{pw} = \$pw;
    my $canvas = $cw->Canvas;
    $cw->{canvas} = $canvas;
    my $frame = $canvas->Frame;
    my $l = $frame->Label(-text => $ti, -font => 'fixed')->grid;
    $cw->{label} = $l;
    my $e = $frame->Entry(-textvariable => \$pw, -show => '*', -width => 10)->grid;
    $cw->{entry} = $e;

    if ($mez eq 'none') {
	$cw->geometry('+' . int($w/2) . '+' . int($h/2));
	$canvas->createWindow(64, 24, -window => $frame);
	$canvas->configure(-width => 126, -height => 47);
    } else {
	$canvas->configure(-width => $w, -height => $h);
	$canvas->createWindow($w/2, $h/2, -window => $frame);
    }
    $canvas->grid;

    # Composite widget parameter definitions.

    $cw->ConfigSpecs(
		     -animation         => [qw/PASSIVE animation Animation lines/],
		     -animationinterval => [qw/PASSIVE animationInterval AnimationInterval 200/],
		     -background        => [$canvas, qw/background Background black/],
		     -foreground        => [$l, qw/ foreground Foreground blue/],
		     -hide              => [qw/PASSIVE hide Hide 10/],
		     -text              => [qw/METHOD text Text/, $ti],
		     );

    $cw->{tid} = undef;		# timer ID
    $cw->{mid} = undef;		# mesmerizer ID
    $cw->{unlock} = 1;		# unlock flag
    $cw->{plug_init} = 0;	# 0 until plugin initialized

    # Widget bindings.

    $cw->bind('<Motion>'   => [\&awake, $cw]);
    $cw->bind('<Any-Key>'  => [\&awake, $cw]);
    $cw->bind('<Double-1>' => [$cw => 'unlock']) if $cw->{-debug};

} # end Populate

# Private methods.

sub awake {

    # Make title and password entry visible by moving them from hyperspace to a visible portion of the canvas.

    my($subwidget, $self) = @_;

    my $canvas = $self->{canvas};
    unless ($self->{Configure}{-animation} eq 'none') {
	$canvas->afterCancel($self->{tid});
	my($w, $h) = ($self->{w}, $self->{h});
	$canvas->coords(1, $w/2, $h/2);
	$self->{tid} = $canvas->after($self->{Configure}{-hide} * 1000 => [$self => 'snooze']);
    }
    
    if (ref($subwidget) eq 'Tk::Entry') {
	if ($Tk::event->K eq 'Return') {
	    return unless ${$self->{pw}};
	    if (&{$self->{-authenticate}}($self->{user}, ${$self->{pw}})) {
	        $self->unlock;
	    } else {
		$self->{entry}->delete(0 => 'end');
		$self->bell;
	    }
        } # ifend <Return>
    } # ifend Entry widget

} # end awake

sub mesmerize {

    # Animate mesmerizer, either user supplied <CODE>, no screensaver, or a builtin plugin.

    my($self) = @_;

    my $canvas = $self->{canvas};
    my $mez = $self->{Configure}{-animation};
    my $ai = undef;

    if (ref($mez) eq 'CODE') {	# user specified mesmerizing routine
        exit unless &$mez($canvas) >= 1;
    } elsif ($mez eq 'none') {
	return;
    } else {
	if ($self->{plug_init}) {
	    exit unless &Animation($canvas) >= 1;
	} else { 
	    no strict qw/refs/;
	    unless (eval "require Tk::LockDisplay::$mez") {
		warn "Couldn't load plugin file '$mez': $@";
		exit;
	    }
	    $ai = &Animation($canvas);
	    unless ($ai >= 1) {
		warn "Plugin '$mez' failed to initialize.";
		exit;
	    }
	    use strict qw/refs/;
	    if ($ai > 1) {	# restart timer event with new cycle value
		$self->{Configure}{-animationinterval} = $ai;
		$self->afterCancel($self->{mid});
		$self->{mid} = $self->repeat($self->{Configure}{-animationinterval} => [$self => 'mesmerize']);
	    }
	    $self->{plug_init} = 1;
	}
    } # end lines
    $canvas->idletasks;		# update() gives deep recursion!

} # end mesmerize

sub snooze {

    # Hide title and password entry by moving the items way off the canvas.

    my($self) = @_;

    my $canvas = $self->{canvas};
    my $mez = $self->{Configure}{-animation};
    $canvas->coords(1, -1000, -1000);

} # end snooze

sub text {

    # Set canvas title text.

    my($self, $text) = @_;
    
    $self->{label}->configure(-text => $text);

} # end text

sub unlock {$_[0]->{unlock}++}	# alert waitVariable() that we're done

1;

=head1 NAME

Tk::LockDisplay - Create modal dialog and wait for a password response.

=for pm Tk/LockDisplay.pm

=for category Screensavers, Popups and Dialogs

=head1 SYNOPSIS

S<    >I<$lock> = I<$parent>-E<gt>B<LockDisplay>(I<-option> =E<gt> I<value>, ... );

=head1 DESCRIPTION

This widget fills the display with a screensaver-like animation, makes
a global grab and then waits for the user's authentication string,
usually their password.  Until the password is entered the display
cannot be used: window manager commands are ignored, etcetera. Note, X
server requests are not blocked.

Password verification is perforemd via a callback passed during widget
creation.

While waiting for the user to respond, B<LockDisplay> sets a global
grab.  This prevents the user from interacting with any application in
any way except to type characters in the LockDisplay entry box.  See
the B<Lock()> method.

The following option/value pairs are supported:

=over 4

=item B<-authenticate>

Password verification subroutine - it's passed two positional
parameters, the username and password, and should return 1 if success,
else 0.

=item B<-animation>

A string indicating what screensaver plugin to use, or 'none' to
disable the screensaver.  Supplied plugins are 'lines' (default), 'neko'  and
'counter', which reside in the directory .../Tk/LockDisplay.  You can
drop a plugin of your own in that directory - see the section Plugin
Format below for details.  You can also supply your own animation
subroutine by passing a B<CODE> reference.  The subroutine is passed a
single parameter, the canvas widget reference, which you can
draw upon as you please.

=item B<-animationinterval>

The number of milliseconds between calls to the screen saver animation code.
Default is 200 milliseconds.  Plugins can specifiy their own interval by
returning the number of milliseconds (> 1) during initialization.

=item B<-hide>

How many seconds of display inactivity before hiding the password
entry widget and canvas title text. Default is 10 seconds.

=item B<-text>

Title text centered in canvas.

=item B<-foreground>

Title text color.

=item B<-background>

Canvas color.

=item B<-debug>

Set to 1 allows a <Double-1> event to unlock the display.  Used while
debugging your authentication callback or plugin.

=back

=head1 METHODS

=over 4

=item C<$lock-E<gt>B<Lock>;>

This method locks the display and waits for the user's authentication data.

=back

=head1 EXAMPLE

I<$lock> = I<$mw>-E<gt>B<LockDisplay>(-authenticate =E<gt> \&check_pw);

sub check_pw {

    # Perform AFS validation unless on Win32.

    my($user, $pw) = @_;

    if ($^O eq 'MSWin32') {
	($pw eq $^O) ? exit(0) : return(0);
    } else {
	system "/usr/afsws/bin/klog $user " . quotemeta($pw) . " 2> /dev/null";
	($? == 0) ? exit(0) : return(0);
    }

} # end check_pw

=head1 PLUGIN FORMAT

Refer to the "counter" plugin file .../Tk/LockDisplay/counter.pm for
details on the structure of a LockDisplay animation plugin.  Basically,
you create a ".pm" file that describes your plugin, "counter.pm" for
instance.  This file must contain a subroutine called Animate($canvas),
where $canvas is the canvas widget reference passed to it.

LockDisplay first require()s your plugin file, and, if that succeeds,
calls it once to perform initialization.  Animate() should return 0 for
failure, 1 for success, and > 1 for success I<and> to specifiy a private
-animationinterval (in milliseconds).  Subsequent calls to Animate() are
for its "main loop" processing.  As before, the return code should be
0 or 1 for failure or success, respectively.

=head1 HISTORY

=over 4

=item Version 1.0

    Beta Release.

=item Version 1.1

    . Implement plugins and other fixes suggested by Achim Bohnet.
      Thanks!
    . Allow plugin name 'none' to disable screensaver.  Thanks to
      Roderick Anderson!

=item Version 1.2

    . getlogin() fails on HPUX, so try getpwuid() as a fallback.
      Thanks to Paul Schinder for the CPAN-Testers bug report.
    . Plugins can return() their own -animationinterval value 
      during preset.
    . Add 'neko' plugin.

=item Version 1.3

    . Fix value of pi in neko plugin!
    . Add Windows 95 support

=back

=head1 AUTHOR

Stephen.O.Lidie@Lehigh.EDU

=head1 COPYRIGHT

Copyright (C) 1998 - 1998, Stephen O. Lidie.

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=head1 KEYWORDS

screeensaver, dialog, modal

=cut