Perl-Skript überwacht D-Bus - Seite 2

Lauscher an der Wand

Während Listing 1 das Remote-Objekt des HAL-Managers anspricht, um die bislang registrierten Geräte aufzuzählen, erfordert ein nach dem Einstöpseln automatisch startendes Backup einen aktiv lauschenden Client, den der D-Bus verzögerungslos benachrichtigt, sobald ein vorher definierter Zustand eingetreten ist.

Da die Dokumentation der Bestandteile ausgesandter D-Bus-Nachrichten oft stark zu wünschen übrig lässt, ist es einfacher, ein Tool wie »dbus-monitor« zu bemühen, das dem Paket »dbus« von Haus aus beiliegt. Es abonniert nach dem Start von der Kommandozeile kurzerhand alle D-Bus-Nachrichten und gibt jede eintreffende Message aus, sobald diese eintrudelt. So zeigt Abbildung 3, dass »dbus-monitor« unter anderem einen »MountAdded«-Event zugesteckt bekommt. Für die Nachricht verantwortlich zeichnet der Service »org.gtk.Private.GduVolumeMonitor«. Dieser Event rührt zweifelsfrei von einer Gnome-Applikation her, die den USB-Stick unter »/media« mountet und dies den Lauschern auf dem D-Bus mitteilt.

Abbildung 3: Der frisch eingestöpselte USB-Stick erscheint als neuer Mount auf dem D-Bus.

Backup auf Kommando

Um diese Events abzufangen, ohne gleich in einer Flut irrelevanten Bus-Geplappers zu ertrinken, meldet sich das Backup-Daemon-Skript »dbus-mount-watcher« aus Listing 2 auf dem D-Bus an, fängt ausschließlich »MountAdded«-Nachrichten ab und untersucht mit Hilfe der voreingestellten UUID A840-E2B3, ob der User den angemeldeten Backup-Stick tatsächlich eingesteckt hat.

Listing 2: »dbus-mount-watcher«
01 #!/usr/local/bin/perl -w 02 use strict; 03 use Net::DBus; 04 use Net::DBus::Reactor; 05 use App::Daemon; 06 use FindBin qw($Bin); 07 use Log::Log4perl qw(:easy); 08 09 use App::Daemon qw( daemonize ); 10 daemonize(); 11 12 INFO "Starting up"; 13 14 my $BACKUP_STICK = 15 "file:///media/A840-E2B3"; 16 my $BACKUP_PROCESS = "$Bin/gtk2-backup"; 17 18 my $notifications = Net::DBus->session 19 ->get_service( 20 "org.gtk.Private.GduVolumeMonitor" ) 21 ->get_object( 22 "/org/gtk/Private/RemoteVolumeMonitor", 23 "org.gtk.Private.RemoteVolumeMonitor", 24 ); 25 26 INFO "Subscribing to signal"; 27 28 $notifications->connect_to_signal( 29 'MountAdded', &mount_added ); 30 31 ########################################### 32 sub mount_added { 33 ########################################### 34 my( $service, $addr, $data ) = @_; 35 36 INFO "Found mount point $data->[4] "; 37 38 if( $data->[4] eq $BACKUP_STICK ) { 39 my $cmd = "DISPLAY=:0.0 " . 40 "$BACKUP_PROCESS $data->[4] &"; 41 INFO "Launching $cmd"; 42 system( $cmd ); 43 } 44 } 45 46 my $reactor = Net::DBus::Reactor->main(); 47 $reactor->run();

Listing 2:
»dbus-mount-watcher«

01 #!/usr/local/bin/perl -w
02 use strict;
03 use Net::DBus;
04 use Net::DBus::Reactor;
05 use App::Daemon;
06 use FindBin qw($Bin);
07 use Log::Log4perl qw(:easy);
08
09 use App::Daemon qw( daemonize );
10 daemonize();
11
12 INFO "Starting up";
13
14 my $BACKUP_STICK =
15      "file:///media/A840-E2B3";
16 my $BACKUP_PROCESS = "$Bin/gtk2-backup";
17
18 my $notifications = Net::DBus->session
19   ->get_service(
20       "org.gtk.Private.GduVolumeMonitor" )
21   ->get_object(
22     "/org/gtk/Private/RemoteVolumeMonitor",
23     "org.gtk.Private.RemoteVolumeMonitor",
24   );
25
26 INFO "Subscribing to signal";
27
28 $notifications->connect_to_signal(
29     'MountAdded', &mount_added );
30
31 ###########################################
32 sub mount_added  {
33 ###########################################
34   my( $service, $addr, $data ) = @_;
35
36   INFO "Found mount point $data->[4] ";
37
38   if( $data->[4] eq $BACKUP_STICK ) {
39     my $cmd = "DISPLAY=:0.0 " .
40       "$BACKUP_PROCESS $data->[4] &";
41     INFO "Launching $cmd";
42     system( $cmd );
43   }
44 }
45
46 my $reactor = Net::DBus::Reactor->main();
47 $reactor->run();

Ist das der Fall und der Event stammt nicht etwa von einem anderen soeben angeschlossenen Gerät, startet das Daemon-Skript die Backup-Applikation »gtk2-backup« in Listing 3. Ihre GTK-Oberfläche zeigt den aktuellen Status der Sicherung auf dem Desktop mit einem Progressbalken an (Abbildung 6).

Listing 3: »gtk2-backup«
01 #!/usr/local/bin/perl -w 02 use strict; 03 use File::Finder; 04 use Glib qw/TRUE FALSE/; 05 use Gtk2 '-init'; 06 use DateTime; 07 08 my $PID; 09 my $tar = "tar"; 10 my $src_dir = "/home/mschilli/test"; 11 my $ymd = DateTime->now->ymd(''); 12 13 my($stick_dir) = @ARGV; 14 15 if(! defined $stick_dir ) { 16 die "usage: $0 stick_dir"; 17 } 18 $stick_dir =~ s#^file://##; 19 20 my $dst_tarball = "$stick_dir/$ymd.tgz"; 21 22 my $NOF_FILES = scalar File::Finder 23 -> type( "f" ) 24 -> in( $src_dir ); 25 26 my $CMD = 27 "$tar zcfv $dst_tarball $src_dir"; 28 29 my $window = Gtk2::Window->new('toplevel'); 30 $window->set_border_width(10); 31 $window->set_size_request( 500, 100 ); 32 33 my $vbox = Gtk2::VBox->new( TRUE, 10 ); 34 $window->add( $vbox ); 35 36 my $pbar = Gtk2::ProgressBar->new(); 37 $pbar->set_fraction(0); 38 $pbar->set_text("Progress"); 39 $vbox->pack_start( $pbar, TRUE, TRUE, 0 ); 40 41 my $cancel = Gtk2::Button->new('Cancel'); 42 $vbox->pack_end( $cancel, 43 FALSE, FALSE, 0 ); 44 $cancel->signal_connect( clicked => 45 sub { kill 2, $PID if defined $PID; 46 Gtk2->main_quit; } ); 47 48 $window->show_all(); 49 50 my $timer = Glib::Timeout->add ( 51 10, &start, $pbar, 52 Glib::G_PRIORITY_LOW ); 53 54 Gtk2->main; 55 56 ########################################### 57 sub start { 58 ########################################### 59 my( $pbar ) = @_; 60 61 $PID = open my $fh, "$CMD \|"; 62 63 my $count = 1; 64 while( <$fh> ) { 65 chomp; 66 next if m#/$#; # skip dirs 67 68 $pbar->set_text( "Backup Progress " . 69 "($count/$NOF_FILES)" ); 70 $pbar->set_fraction($count/$NOF_FILES); 71 72 Gtk2->main_iteration while 73 Gtk2->events_pending; 74 75 $count++; 76 } 77 78 close $fh or die "$CMD failed ($!)"; 79 80 $cancel->set_label( "Success. Hooray!" ); 81 undef $PID; 82 83 return Glib::SOURCE_REMOVE; 84 }

Listing 3:
»gtk2-backup«

01 #!/usr/local/bin/perl -w
02 use strict;
03 use File::Finder;
04 use Glib qw/TRUE FALSE/;
05 use Gtk2 '-init';
06 use DateTime;
07
08 my $PID;
09 my $tar     = "tar";
10 my $src_dir = "/home/mschilli/test";
11 my $ymd     = DateTime->now->ymd('');
12
13 my($stick_dir) = @ARGV;
14
15 if(! defined $stick_dir ) {
16     die "usage: $0 stick_dir";
17 }
18 $stick_dir =~ s#^file://##;
19
20 my $dst_tarball = "$stick_dir/$ymd.tgz";
21
22 my $NOF_FILES = scalar File::Finder
23     -> type( "f" )
24     -> in( $src_dir );
25
26 my $CMD =
27   "$tar zcfv $dst_tarball $src_dir";
28
29 my $window = Gtk2::Window->new('toplevel');
30 $window->set_border_width(10);
31 $window->set_size_request( 500, 100 );
32
33 my $vbox = Gtk2::VBox->new( TRUE, 10 );
34 $window->add( $vbox );
35
36 my $pbar = Gtk2::ProgressBar->new();
37 $pbar->set_fraction(0);
38 $pbar->set_text("Progress");
39 $vbox->pack_start( $pbar, TRUE, TRUE, 0 );
40
41 my $cancel = Gtk2::Button->new('Cancel');
42 $vbox->pack_end( $cancel,
43                  FALSE, FALSE, 0 );
44 $cancel->signal_connect( clicked =>
45     sub { kill 2, $PID if defined $PID;
46           Gtk2->main_quit; } );
47
48 $window->show_all();
49
50 my $timer = Glib::Timeout->add (
51   10, &start, $pbar,
52   Glib::G_PRIORITY_LOW );
53
54 Gtk2->main;
55
56 ###########################################
57 sub start {
58 ###########################################
59   my( $pbar ) = @_;
60
61   $PID = open my $fh, "$CMD |";
62
63   my $count = 1;
64   while( <$fh> ) {
65     chomp;
66     next if m#/$#; # skip dirs
67
68     $pbar->set_text( "Backup Progress " .
69       "($count/$NOF_FILES)" );
70     $pbar->set_fraction($count/$NOF_FILES);
71
72     Gtk2->main_iteration while
73       Gtk2->events_pending;
74
75     $count++;
76   }
77
78   close $fh or die "$CMD failed ($!)";
79
80   $cancel->set_label( "Success. Hooray!" );
81   undef $PID;
82
83   return Glib::SOURCE_REMOVE;
84 }