File Coverage

blib/lib/App/PerlXLock.pm

Criterion	Covered	Total	%
statement	17	45	37.7
branch	0	10	0.0
condition	0	3	0.0
subroutine	7	13	53.8
pod	0	8	0.0
total	24	79	30.3

package App::PerlXLock;
use strict;
use warnings;
use base 'Exporter';
our $VERSION = "0.01";
our @EXPORT  = qw(main_loop);
use Inline C => Config => LIBS => '-lX11';
use Inline
  C       => "DATA",
  NAME    => "App::PerlXLock",
  VERSION => '0.01',
  INC     => '/usr/include';

END {
    Inline->init();
}

my @buffer;
my @windows;
my @screens;

sub lock_all {
    my $d = shift();
    for ( 0 .. screen_count($d) - 1 ) {
        push( @screens, $_ );
        push( @windows, open_lock( $d, $_ ) );
    }
}

sub has_shadow {
    -e "/etc/shadow";
}

sub shadow_readable {
    -r "/etc/shadow";
}

sub password_accessible {
    has_shadow() && shadow_readable();
}

sub open_locks {
    my $d = shift();
    for (@windows) {
        close_window( $d, $_ );
    }
}

sub check_event {
    my $ev = read_event( $_[0] );
    $ev > 0 ? push( @buffer, chr($ev) ) : undef;
}

sub main_loop {
    my $d = open_connection();
    lock_all($d);
    grab_keyboard( $d, 0 );
    my $locked = 1;
    while ($locked) {
        check_event($d);
        if ( $buffer[-1] && $buffer[-1] eq "\n" ) {
            pop(@buffer);
            if ( password_accessible() ) {
                for my $n ( 0 .. $#buffer ) {
                    if ( check_password( join( "", @buffer[ $n .. $#buffer ] ) ) == 0 ) {
                        $locked = 0;
                    }
                }
            }
            else {
                $locked = 0;
            }
            @buffer = ();
        }
    }
    unlock_all($d);
    ungrab_keyboard($d);
}

sub unlock_all {
    my $d = shift;
    destroy_window( $d, $_ ) for (@windows);
}

has_shadow() || print "/etc/shadow does not exist. Xlock is not password protected.\n";
shadow_readable
  || print "No permissions to read /etc/shadow. Xlock is not password protected.\n";

1;

__DATA__