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