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

    # 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);
    }

$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;