path: root/xscreensaver-dbus

#!/home/dakkar/perl5/perlbrew/perls/perl-5.32.0/bin/perl 
use strict;
use warnings;
 
=pod
 
see https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=781961
 
https://www.freedesktop.org/wiki/Software/systemd/inhibit/
 
https://stackoverflow.com/questions/460140/is-there-a-decent-way-to-inhibit-screensavers-in-linux
 
https://github.com/mato/xscreensaver-systemd/blob/master/xscreensaver-systemd.c
 
=cut
 
package SleepInhibit {
    use Moo;
    use experimental 'signatures';
    use curry;
    use Net::DBus;
    use Log::Any '$log';
 
    has bus => ( is => 'lazy', builder => sub { Net::DBus->system() } );
    has logind_srv => (
        is => 'lazy',
        builder => sub { shift->bus->get_service('org.freedesktop.login1') },
    );
    has logind_obj => (
        is => 'lazy',
        builder => sub { shift->logind_srv->get_object('/org/freedesktop/login1') },
    );
 
    has inhibit_fd => ( is => 'rwp' );
 
    sub start($self) {
        $self->logind_obj->connect_to_signal(
            'PrepareForSleep',
            $self->curry::weak::going_to_sleep,
        );
        $self->inhibit();
        return;
    }
 
    sub inhibit($self) {
        return if $self->inhibit_fd;
        $self->_set_inhibit_fd(
            $self->logind_obj->Inhibit(
                'sleep',
                'xscreensaver','locking before sleep',
                'delay',
            )
        );
        $log->debugf('got logind inhibit fd %d',$self->inhibit_fd);
        return;
    }
 
    sub going_to_sleep($self,$before) {
        if ($before) {
            $log->debug('locking');
            system(qw(xscreensaver-command -suspend));
            $log->debug('locked');
            $self->_set_inhibit_fd(undef);
        }
        else {
            $log->debug('woken up');
            system(qw(xscreensaver-command -deactivate));
            $self->inhibit();
        }
        return;
    }
};
 
package SaverImpl {
    use strict;
    use warnings;
    use experimental 'signatures';
    # this is the interface name 
    use Net::DBus::Exporter qw(org.freedesktop.ScreenSaver);
    use parent 'Net::DBus::Object';
 
    dbus_method('Inhibit',['string','string'],['uint32']);
    dbus_method('UnInhibit',['uint32'],[]);
 
    sub new($class,$service,$path,$inhibit_cb,$uninhibit_cb) {
        my $self = $class->SUPER::new($service, $path);
        bless $self, $class;
        $self->{__inhibit_cb} = $inhibit_cb;
        $self->{__uninhibit_cb} = $uninhibit_cb;
        return $self;
    }
 
    our $_message;
    sub _dispatch_object($self,$connection,$message,@etc) {
        local $_message = $message;
        return $self->SUPER::_dispatch_object($connection,$message,@etc);
    }
 
    sub Inhibit($self,$name,$reason) {
        return $self->{__inhibit_cb}->($name,$reason,$_message);
    }
 
    sub UnInhibit($self,$cookie) {
        return $self->{__uninhibit_cb}->($cookie,$_message);
    }
};
 
package Saver {
    use Moo;
    use experimental 'signatures';
    use curry;
    use Log::Any '$log';
    use Try::Tiny;
 
    has reactor => ( is => 'ro', required => 1 );
    has bus => ( is => 'lazy', builder => sub { Net::DBus->session() } );
    has dbus_srv => ( is => 'lazy', builder => sub { shift->bus->get_service('org.freedesktop.DBus') });
    has dbus_obj => ( is => 'lazy', builder => sub { shift->dbus_srv->get_object('/org/freedesktop/DBus') });
 
    has service => (
        is => 'lazy',
        builder => sub {
            # this is the service name 
            shift->bus->export_service('org.freedesktop.ScreenSaver');
        },
    );
    has paths => (
        is => 'ro',
        default => sub { [qw(/ScreenSaver /org/freedesktop/ScreenSaver)] },
    );
 
    has _impls => ( is => 'rw' );
    has _prod_id => ( is => 'rw' );
    has _inhibits => ( is => 'rw', default => sub { +{} } );
 
    sub start($self) {
        my $inhibit_cb = $self->curry::weak::inhibit;
        my $uninhibit_cb = $self->curry::weak::uninhibit;
 
        $self->_impls([ map {
            SaverImpl->new(
                $self->service,
                $_,
                $inhibit_cb,
                $uninhibit_cb,
            )
        } $self->paths->@* ]);
 
        $self->_prod_id(
            $self->reactor->add_timeout(
                60_000,
                Net::DBus::Callback->new(
                    method => $self->curry::weak::prod_screensaver
                ),
                0,
            ),
        );
 
        return;
    }
 
    sub inhibit($self,$name,$reason,$message) {
        my $sender_pid = try {
            return $self->dbus_obj->GetConnectionUnixProcessID(
                $message->get_sender,
            );
        } catch {
            $log->warning('problems getting PID of inhibitor',{error=>$_});
            return undef;
        };
 
        my $cookie;
        do {
            $cookie = int(rand(2**31))
        } until !exists $self->_inhibits->{$cookie};
 
        $self->_inhibits->{$cookie} = [ $name, $reason, $sender_pid ];
 
        $log->debugf(
            '<%s> stops screensaver for <%s> (cookie %d) - %d active',
            $name, $reason, $cookie, scalar(keys $self->_inhibits->%*),
        );
        $self->reactor->toggle_timeout($self->_prod_id, 1);
 
        return $cookie;
    }
 
    sub uninhibit($self,$cookie,$message) {
        my $inhibit = delete $self->_inhibits->{$cookie}
            or return;
        my ($name, $reason, $sender_pid) = @$inhibit;
 
        $log->debugf(
            '<%s> resumed screensaver for <%s> (cookie %d) - %d left',
            $name, $reason, $cookie, scalar(keys $self->_inhibits->%*),
        );
 
        $self->reactor->toggle_timeout($self->_prod_id, 0)
            unless $self->_inhibits->%*;
 
        return;
    }
 
    sub prod_screensaver($self) {
        for my $cookie (sort keys $self->_inhibits->%*) {
            my ($name, $reason, $sender_pid) = @{$self->_inhibits->{$cookie}};
            next if kill 0, $sender_pid;
            # uh oh, caller is dead 
            my $inhibit = delete $self->_inhibits->{$cookie};
 
            $log->debugf(
                '<%s> is dead (it stopped screensaver for <%s>, cookie %d) - %d left',
                $name, $reason, $cookie, scalar(keys $self->_inhibits->%*),
            );
        }
 
        unless ($self->_inhibits->%*) {
            $self->reactor->toggle_timeout($self->_prod_id, 0);
            return;
        }
 
        $log->debug('prodding xscreensaver');
        system(qw(xscreensaver-command -deactivate));
    }
};
 
use Net::DBus::Reactor;
use Log::Any::Adapter Stdout => ( log_level => 'debug' );
 
my $reactor = Net::DBus::Reactor->main();
 
my $sleep = SleepInhibit->new();
$sleep->start();
 
my $saver = Saver->new(reactor => $reactor);
$saver->start();
 
$reactor->run();