avoid re-setting the exit code after waiting for upgrade monitoring process to terminate
[monkeysphere-validation-agent.git] / Crypt / Monkeysphere / MSVA / Monitor.pm
1 #----------------------------------------------------------------------
2 # Monkeysphere Validation Agent, Perl version
3 # Marginal User Interface for reasonable prompting
4 # Copyright © 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>,
5 #                  Matthew James Goins <mjgoins@openflows.com>,
6 #                  Jameson Graef Rollins <jrollins@finestructure.net>,
7 #                  Elliot Winard <enw@caveteen.com>
8 #
9 # This program is free software: you can redistribute it and/or modify
10 # it under the terms of the GNU General Public License as published by
11 # the Free Software Foundation, either version 3 of the License, or
12 # (at your option) any later version.
13 #
14 # This program is distributed in the hope that it will be useful,
15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 # GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License
20 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
21 #
22 #----------------------------------------------------------------------
23
24 { package Crypt::Monkeysphere::MSVA::Monitor;
25
26   use strict;
27   use warnings;
28
29   sub createwindow {
30     my $self = shift;
31
32     require Gtk2;
33     Gtk2->init();
34     $self->{dialog} = Gtk2::Dialog->new("Monkeysphere Validation Agent updated!",
35                                         undef,
36                                         [],
37                                         'gtk-no' => 'cancel',
38                                         'gtk-yes' => 'ok');
39
40     my $icon_file = '/usr/share/pixmaps/monkeysphere-icon.png';
41
42     $self->{dialog}->set_default_icon_from_file($icon_file)
43       if (-r $icon_file);
44     $self->{dialog}->set_default_response('ok');
45     my $label = Gtk2::Label->new("Some components of the running Monkeysphere
46 Validation Agent have been updated.
47
48 Would you like to restart the validation agent?");
49     $label->show();
50     $self->{dialog}->get_content_area()->add($label);
51     $self->{dialog}->signal_connect(response => sub { my ($dialog,$resp) = @_; $self->button_clicked($resp); });
52     $self->{dialog}->signal_connect(delete_event => sub { $self->button_clicked('cancel'); return 1; });
53   }
54
55   sub button_clicked {
56     my $self = shift;
57     my $resp = shift;
58     if ($resp eq 'ok') {
59       # if the user wants to restart the validation agent, we should terminate
60       # so that our parent gets a SIGCHLD.
61       exit 0;
62     } else {
63       $self->{dialog}->hide();
64     }
65   }
66
67   sub prompt {
68     my $self = shift;
69     $self->{dialog}->show();
70   }
71
72   sub spawn {
73     my $self = shift;
74     if (! Module::Load::Conditional::can_load('modules' => { 'Gtk2' => undef,
75                                                              'AnyEvent' => undef,
76                                                              'Linux::Inotify2' => undef,
77                                                            })) {
78       $self->{logger}->log('info', "Not spawning a monitoring process; issue 'kill -s HUP %d' to restart after upgrades.\nInstall Perl modules Gtk2, AnyEvent, and Linux::Inotify2 for automated restarts on upgrades.\n", $$);
79       return;
80     }
81     my $fork = fork();
82     if (! defined $fork) {
83       $self->{logger}->log('error', "Failed to spawn monitoring process\n");
84       return;
85     }
86     if ($fork) {
87       $self->{monitorpid} = $fork;
88       $self->{logger}->log('debug', "spawned monitoring process pid %d\n", $self->{monitorpid});
89       return;
90     } else {
91       $self->childmain();
92     }
93   }
94
95   sub childmain {
96     my $self = shift;
97
98     $self->{files} = [ $0, values(%INC) ];
99     $self->{logger}->log('debug3', "setting up monitoring on these files:\n%s\n", join("\n", @{$self->{files}}));
100
101     # close all filedescriptors except for std{in,out,err}:
102     # see http://markmail.org/message/mlbnvfa7ds25az2u
103     close $_ for map { /^(?:ARGV|std(?:err|out|in)|STD(?:ERR|OUT|IN))$/ ? () : *{$::{$_}}{IO} || () } keys %::;
104
105     $self->createwindow();
106
107     require Linux::Inotify2;
108
109     $self->{inotify} = new Linux::Inotify2
110       or die "unable to create new inotify object: $!";
111
112     my $flags = 0xc06;
113     # FIXME: couldn't figure out how to get these to work in "strict subs" mode:
114     # my $flags = Linux::Inotify2::IN_MODIFY |
115                 # Linux::Inotify2::IN_ATTRIB |
116                 # Linux::Inotify2::IN_DELETE_SELF |
117                 # Linux::Inotify2::IN_MOVE_SELF;
118
119     foreach my $file (@{$self->{files}}) {
120       $self->{inotify}->watch($file,
121                               $flags,
122                               sub {
123                                 $self->prompt();
124                               });
125     }
126
127     require AnyEvent;
128     my $inotify_w = AnyEvent->io (
129                                   fh => $self->{inotify}->fileno,
130                                   poll => 'r',
131                                   cb => sub { $self->changed },
132                                  );
133     my $w = AnyEvent->signal(signal => 'TERM', cb => sub { exit 1; });
134
135     Gtk2->main();
136     $self->{logger}->log('error', "Got to the end of the monitor process somehow\n");
137     # if we get here, we want to terminate with non-zero
138     exit 1;
139   }
140
141
142   sub changed {
143     my $self = shift;
144
145     $self->{logger}->log('debug', "changed!\n");
146     $self->{inotify}->poll();
147   }
148
149   # forget about cleaning up the monitoring child (e.g. we only want
150   # the parent process to know about this)
151   sub forget {
152     my $self = shift;
153     undef $self->{monitorpid};
154   }
155
156   sub getchildpid {
157     my $self = shift;
158     return $self->{monitorpid};
159   }
160
161   sub DESTROY {
162     my $self = shift;
163     if (defined $self->{monitorpid}) {
164       kill('TERM', $self->{monitorpid});
165       my $oldexit = $?;
166       waitpid($self->{monitorpid}, 0);
167       $? = $oldexit;
168       undef($self->{monitorpid});
169     }
170   }
171
172   sub new {
173     my $class = shift;
174     my $logger = shift;
175
176     my $self = { monitorpid => undef,
177                  logger => $logger,
178                };
179
180     bless ($self, $class);
181
182     $self->spawn();
183     return $self;
184   }
185
186   1;
187 }