From 15be5213c8cedc3cefc7f1682e752ff5483d287e Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Thu, 6 May 2021 15:04:16 +0100
Subject: lock the screen when logind says so

---
 lib/App/XScreenSaver/DBus.pm      |  13 +++++
 lib/App/XScreenSaver/DBus/Lock.pm | 111 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 124 insertions(+)
 create mode 100644 lib/App/XScreenSaver/DBus/Lock.pm

(limited to 'lib')

diff --git a/lib/App/XScreenSaver/DBus.pm b/lib/App/XScreenSaver/DBus.pm
index 2ab384a..db9355f 100644
--- a/lib/App/XScreenSaver/DBus.pm
+++ b/lib/App/XScreenSaver/DBus.pm
@@ -6,6 +6,7 @@ use Net::DBus::Reactor;
 use Log::Any;
 use App::XScreenSaver::DBus::InhibitSleep;
 use App::XScreenSaver::DBus::Saver;
+use App::XScreenSaver::DBus::Lock;
 # VERSION
 # ABSTRACT: main application class
 
@@ -49,6 +50,17 @@ has saver => (
     },
 );
 
+=attr C<lock>
+
+instance of L<< C<App::XScreenSaver::DBus::Lock> >>.
+
+=cut
+
+has lock => (
+    is => 'lazy',
+    builder => sub { App::XScreenSaver::DBus::Lock->new() },
+);
+
 =attr C<log>
 
 a logger
@@ -67,6 +79,7 @@ not return
 sub run($self) {
     $self->inhibit_sleep->start();
     $self->saver->start();
+    $self->lock->start();
     $self->reactor->run;
 }
 
diff --git a/lib/App/XScreenSaver/DBus/Lock.pm b/lib/App/XScreenSaver/DBus/Lock.pm
new file mode 100644
index 0000000..22410f2
--- /dev/null
+++ b/lib/App/XScreenSaver/DBus/Lock.pm
@@ -0,0 +1,111 @@
+package App::XScreenSaver::DBus::Lock;
+use v5.20;
+use Moo;
+use experimental qw(signatures postderef);
+use curry;
+use Net::DBus;
+use IPC::Run;
+use Log::Any;
+# VERSION
+# ABSTRACT: implements the logind "session lock" protocol
+
+=head1 SYNOPSIS
+
+    use Net::DBus::Reactor;
+    use App::XScreenSaver::DBus::Lock;
+    my $is = App::XScreenSaver::DBus::Lock->new;
+    $is->start;
+
+    Net::DBus::Reactor->new->run;
+
+=attr C<bus>
+
+the DBus system bus
+
+=cut
+
+has bus => ( is => 'lazy', builder => sub { Net::DBus->system() } );
+
+=attr C<logind_srv>
+
+the (e)logind DBus service
+
+=cut
+
+has logind_srv => (
+    is => 'lazy',
+    builder => sub { shift->bus->get_service('org.freedesktop.login1') },
+);
+
+=attr C<logind_obj>
+
+the (e)logind DBus object
+
+=cut
+
+has logind_obj => (
+    is => 'lazy',
+    builder => sub { shift->logind_srv->get_object('/org/freedesktop/login1') },
+);
+
+=attr C<session_obj>
+
+the (e)logind session DBus object
+
+=cut
+
+has session_obj => (
+    is => 'lazy',
+    builder => sub($self) {
+        my $session_path = $self->logind_obj->GetSessionByPID($$);
+        return $self->logind_srv->get_object($session_path);
+    },
+);
+
+=attr C<log>
+
+a logger
+
+=cut
+
+has log => ( is => 'lazy', builder => sub { Log::Any->get_logger } );
+
+=method C<start>
+
+starts listening to the C<Lock> and C<Unlock> signals from the
+session, and activates the screen saver
+
+=cut
+
+sub start($self) {
+    $self->session_obj->connect_to_signal(
+        'Lock',
+        $self->curry::weak::_lock,
+    );
+    $self->session_obj->connect_to_signal(
+        'Unlock',
+        $self->curry::weak::_unlock,
+    );
+    return;
+}
+
+sub _lock($self) {
+    $self->_xscreensaver_command('-lock');
+}
+
+sub _unlock($self) {
+    $self->_xscreensaver_command('-deactivate');
+}
+
+sub _xscreensaver_command($self,$command) {
+    my ($out, $err);
+    IPC::Run::run(
+        ['xscreensaver-command',$command],
+        \undef, \$out, \$err,
+    );
+    $self->log->tracef('xscreensaver-command %s said <%s>',$command,$out);
+    $self->log->warnf('xscreensaver-command %s errored <%s>',$command,$err)
+        if $err;
+}
+
+1;
-- 
cgit v1.2.3