bug in regexp if gecos empty
[projets/gtk-fuser.git] / gtk-fuser
1 #!/usr/bin/perl -w
2 # $Id$
3
4 # gtk-fuser, a perl-gtk2 frontend to fuser (from psmisc)
5 # Copyright (C) 2005 Guillaume Castagnino
6 #
7 # This program is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 2 of the License, or
10 # (at your option) any later version.
11 #
12 # This program is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
20 #
21 # Guillaume Castagnino <casta@xwing.info>
22
23 require 5.004;
24
25 use strict;
26 use utf8;
27 use Gtk2::Pango;
28 use POSIX qw(locale_h);
29 use Data::Dumper;
30
31 ###############
32 # Global vars #
33 ###############
34
35 my $fuserCommand = "/usr/bin/fuser";
36 my $SigtermTimeout = 2;
37 my $build = '$Id$';
38 my $processes = {};
39 my $passwdMap = {};
40 my $debug = 0;
41
42 ########
43 # Init #
44 ########
45
46 mapUidUsername ();
47 $build =~ s/^\$Id:\s+//g;
48 $build =~ s/Z\s+\S+\s+\$$//g;
49 print Dumper $passwdMap if $debug;
50
51 # Configuring locale
52 my $lc_messages = setlocale (LC_MESSAGES);
53 my $codeset = 'default';
54 $codeset = 'fr' if $lc_messages =~ m/fr/i;
55 my $locale = getStrings ($codeset);
56
57 ##################
58 # Init Interface #
59 ##################
60
61 use Gtk2 '-init';
62
63 my $window = Gtk2::Window->new ('toplevel');
64 $window->set_title (_("Gtk-Fuser : a Gtk2 fuser Front-End"));
65 $window->set_default_size (640, 480);
66 # Window events
67 $window->signal_connect ('delete_event', \&quit);
68 $window->signal_connect ('destroy', \&quit);
69
70 # Buttons
71 my $bKill = Gtk2::Button->new (_("Kill processes"));
72 my $bSearch = Gtk2::Button->new (_("Launch search"));
73 my $bBrowseFile = Gtk2::Button->new (_("File"));
74 my $bBrowseFolder = Gtk2::Button->new (_("Directory"));
75 # Connect signal buttons
76 $bKill->signal_connect ('clicked', \&killPids);
77 $bSearch->signal_connect ('clicked', \&search);
78 $bBrowseFile->signal_connect ('clicked', \&selectFile);
79 $bBrowseFolder->signal_connect ('clicked', \&selectFolder);
80
81 # Entry
82 my $pathEntry = Gtk2::Entry->new ();
83 $pathEntry->set_text (_("Path"));
84 $pathEntry->set_activates_default (1);
85 $pathEntry->signal_connect ('activate', \&search);
86
87 # progress-bar
88 my $progressBar = Gtk2::ProgressBar->new ();
89 $progressBar->set_fraction (0);
90
91 # PList
92 my $pTextBuffer = Gtk2::TextBuffer->new ();
93 $pTextBuffer->create_tag ('bold', weight => PANGO_WEIGHT_BOLD);
94 $pTextBuffer->create_tag ('fixed', family => "Courier 10 pitch");
95 $pTextBuffer->create_tag ('gapbold', pixels_above_lines => 10, weight => PANGO_WEIGHT_BOLD, underline => 'single');
96 $pTextBuffer->create_tag ('underline', underline => 'single');
97 my $pText = Gtk2::TextView->new_with_buffer ($pTextBuffer);
98 $pText->set_indent (10);
99 $pText->set_editable (0);
100 $pText->set_cursor_visible (0);
101 $pText->set_wrap_mode ('none');
102 $pText->set_right_margin (20);
103 my $pTextScroll = Gtk2::ScrolledWindow->new ();
104 $pTextScroll->set_policy ('automatic', 'automatic');
105 $pTextScroll->add ($pText);
106
107 # Statutbar
108 my $statusBar = Gtk2::Statusbar->new ();
109 my $contextId = $statusBar->get_context_id ("StatusBar");
110 $statusBar->push ($contextId, $build);
111
112 # Layout
113 my $vbox = Gtk2::VBox->new (0, 0);
114 my $hbox = Gtk2::HBox->new (0, 4);
115
116 $hbox->pack_start ($pathEntry, 1, 1, 0);
117 $hbox->pack_start ($bBrowseFile, 0, 0, 0);
118 $hbox->pack_start ($bBrowseFolder, 0, 0, 0);
119 $vbox->pack_start ($hbox, 0, 0, 4);
120 $vbox->pack_start ($bSearch, 0, 0, 2);
121 $vbox->pack_start ($pTextScroll, 1, 1, 2);
122 $vbox->pack_start ($bKill, 0, 0, 2);
123 $vbox->pack_start ($progressBar, 0, 0, 4);
124 $vbox->pack_start ($statusBar, 0, 0, 0);
125 $window->add ($vbox);
126
127 # Draw interface
128 $window->show_all ();
129
130 # Launch main loop
131 Gtk2->main ();
132
133 ###############
134 # Subroutines #
135 ###############
136
137 sub mapUidUsername
138 {
139     open PASSWD, "/etc/passwd";
140     while (my $l = <PASSWD>)
141     {
142         next if $l =~ m/^#/;
143         if (my @match = ($l =~ m/^([^:]+):[^:]+:(\d+):(\d+):([^:]*):/))
144         {
145             my $username = $match[0];
146             my $uid = $match[1];
147             my $gid = $match[2];
148             my $gecos = $match[3];
149             $passwdMap->{$uid} = "$username";
150             $passwdMap->{$uid} .= " / $gecos" if $gecos ne "";
151         }
152     }
153 }
154
155 sub search
156 {
157     my $searchText = $pathEntry->get_text ();
158     emptyText ();
159     # Invalid path or more than one path
160     return -1 if not -e $searchText;
161
162     my $regexpText = quotemeta $searchText;
163     my $fuser = `$fuserCommand -c $searchText 2>&1`;
164     chomp $fuser;
165     $fuser =~ s/^\s+//;
166     $fuser =~ s/\s+$//;
167     $processes = {};
168     my @fuser = split(/\s+/, $fuser);
169     print Dumper \@fuser if $debug;
170     for my $pinfo (@fuser)
171     {
172         # Search infos on process
173         my @match = ($pinfo =~ m/^(\d+)/); # extract PID
174         next if not defined $match[0];
175         my $p = $match[0];
176         my $pidHome = "/proc/$p";
177         my $process = {pid => $p};
178         next if not -r "$pidHome/status";
179         print "Opening $pidHome/status\n" if $debug;
180         if (not (open (PINFO, "$pidHome/status")))
181         {
182             print STDERR _("Can't open")." $pidHome/status\n";
183             next;
184         }
185         while (<PINFO>)
186         {
187             $process->{name} = $1 if m/^Name:\s*(\S+)\s*/;
188             $process->{uid} = $passwdMap->{$1} if m/^Uid:\s*(\S+)\s*/;
189         }
190         close PINFO;
191         # Serching for other attrs
192         my $fdList = {};
193         if ($pinfo =~ m/c/ and -r "$pidHome/cwd") # cwd
194         {
195             my $cwd = readlink ("$pidHome/cwd") if -l "$pidHome/cwd";
196             $fdList->{"%> "._("Current directory")." : $cwd"} = 1 if $cwd =~ m/$regexpText/;
197         }
198         if ($pinfo =~ m/e/ and -r "$pidHome/exe") # exe
199         {
200             my $exe = readlink ("$pidHome/exe") if -l "$pidHome/exe";
201             $fdList->{"%> $exe "._("currently running")} = 1 if $exe =~ m/$regexpText/;
202         }
203         if ($pinfo =~ m/r/ and -r "$pidHome/root") # root
204         {
205             my $root = readlink ("$pidHome/root") if -l "$pidHome/root";
206             $fdList->{"%> "._("Root directory")." : $root"} = 1 if $root =~ m/$regexpText/;
207         }
208         # Search for openned handles in searchText path
209         next if not -r "$pidHome/fd";
210         if (not (opendir (FDDIR, "$pidHome/fd")))
211         {
212             print STDERR  _("Can't open")." $pidHome/fd\n";
213             next;
214         }
215         my @fds = readdir (FDDIR);
216         closedir FDDIR;
217         for my $fd (@fds)
218         {
219             next if $fd =~ m/^\./;
220             my $absPath = "$pidHome/fd/$fd";
221             $absPath = readlink $absPath if -l $absPath;
222             $fdList->{"=> FD : $absPath"} = 1 if $absPath =~ m/$regexpText/;
223         }
224         $process->{fds} = $fdList;
225         $processes->{$p} = $process if scalar %$fdList;
226     }
227     print Dumper $processes if $debug;
228     setText ();
229     return 0;
230 }
231
232 sub killPids
233 {
234     my $nbPids = keys %$processes;
235     return -1 if $nbPids == 0;
236
237     deactivate ();
238
239     # Box are you sure ?
240     if (confirmBox ($nbPids) ne 'ok')
241     {
242         activate ();
243         return -1;
244     }
245
246     my $steps = 3 * $nbPids;
247     my $count = 1;
248     for my $pid (keys %$processes)
249     {
250         $progressBar->set_fraction ($count++ / $steps);
251         yield ();
252         print "killing -SIGTERM pid $pid\n" if $debug;
253         kill (15, $pid);
254     }
255     # Time for processes to die
256     sleep ($SigtermTimeout);
257     for my $pid (keys %$processes)
258     {
259         $progressBar->set_fraction ($count++ / $steps);
260         yield ();
261         print "verifying if pid $pid is still alive\n" if $debug;
262         if (kill (0, $pid) == 1)
263         {
264             print "killing -SIGKILL pid $pid\n" if $debug;
265             kill (9, $pid);
266         }
267     }
268     # Second timeout
269     sleep ($SigtermTimeout);
270     my @notKilled = ();
271     for my $pid (keys %$processes)
272     {
273         $progressBar->set_fraction ($count++ / $steps);
274         yield ();
275         print "verifying if pid $pid is still alive\n" if $debug;
276         if (kill (0, $pid) == 1)
277         {
278             push @notKilled, $pid;
279         }
280     }
281     print "Kill Done\nNot killed :\n" if $debug;
282     print Dumper \@notKilled if $debug;
283
284     $progressBar->set_fraction (0);
285     my $nbNotKilled = @notKilled;
286     infoBox ($nbNotKilled);
287     search ();
288
289     activate ();
290
291     return 0;
292 }
293
294 sub setText
295 {
296     emptyText ();
297     my $iter = $pTextBuffer->get_iter_at_offset (0);
298     for my $pid (sort {$a <=> $b} keys %$processes)
299     {
300         my $process = $processes->{$pid};
301         my $pid = $process->{pid};
302         my $name = $process->{name};
303         my $uid = $process->{uid};
304         my $fdsList = $process->{fds};
305         $pTextBuffer->insert_with_tags_by_name ($iter, _("- Process : "), 'gapbold');
306         $pTextBuffer->insert_with_tags_by_name ($iter, "$name ($pid)\n", 'underline');
307         $pTextBuffer->insert_with_tags_by_name ($iter, _("- Owner : "), 'bold');
308         $pTextBuffer->insert ($iter, "$uid\n");
309         for my $path (sort keys %$fdsList)
310         {
311             $pTextBuffer->insert_with_tags_by_name ($iter, "\t$path\n", 'fixed');
312         }
313     }
314 }
315
316 sub emptyText
317 {
318     $pTextBuffer->set_text ('');
319 }
320
321 sub confirmBox
322 {
323     my $nb = shift;
324     my $dialog = Gtk2::MessageDialog->new ($window,
325                                        [qw/modal destroy-with-parent/],
326                                        'question', 'ok-cancel',
327                                        _("Are you sure to want to kill ").$nb._(" processes ?"));
328     my $return = $dialog->run ();
329     $dialog->destroy ();
330     yield ();
331     return $return;
332 }
333
334 sub infoBox
335 {
336     my $nb = shift;
337     my $dialog;
338     if ($nb > 0)
339     {
340         $dialog = Gtk2::MessageDialog->new ($window,
341                                        [qw/modal destroy-with-parent/],
342                                        'info', 'ok',
343                                        $nb._("processes still alive"));
344     }
345     else
346     {
347         $dialog = Gtk2::MessageDialog->new ($window,
348                                        [qw/modal destroy-with-parent/],
349                                        'info', 'ok',
350                                        _("Operation succesfull"));
351     }
352     $dialog->run ();
353     $dialog->destroy ();
354     yield ();
355 }
356
357 sub selectFile
358 {
359     my $fs = Gtk2::FileChooserDialog->new (
360             _("Choose a file"),
361             $window,
362             'open',
363             'gtk-cancel' => 'cancel',
364             'gtk-open' => 'ok');
365
366     $fs->run ();
367     $pathEntry->set_text ($fs->get_filename ());
368     $fs->destroy ();
369     search ();
370     yield ();
371 }
372
373 sub selectFolder
374 {
375     my $fs = Gtk2::FileChooserDialog->new (
376             _("Choose a folder"),
377             $window,
378             'select-folder',
379             'gtk-cancel' => 'cancel',
380             'gtk-open' => 'ok');
381
382     $fs->run ();
383     $pathEntry->set_text ($fs->get_filename ());
384     $fs->destroy ();
385     search ();
386     yield ();
387 }
388
389 sub activate
390 {
391     sensitiveWidgets (1);
392     yield ();
393 }
394
395 sub deactivate
396 {
397     sensitiveWidgets (0);
398     yield ();
399 }
400
401 sub sensitiveWidgets
402 {
403     my $value = shift;
404     $pathEntry->set_sensitive ($value);
405     $bKill->set_sensitive ($value);
406     $bSearch->set_sensitive ($value);
407 }
408
409 sub yield
410 {
411     while (Gtk2->events_pending ())
412     {
413         Gtk2->main_iteration ();
414     }
415 }
416
417 sub quit
418 {
419     Gtk2->main_quit ();
420     return 0;
421 }
422
423 ##################
424 # i18n functions #
425 ##################
426
427 # We are not using standard i18n, since we want a "one file" application
428
429 sub _
430 {
431     my $text = shift;
432     return $text if $codeset eq 'default';
433     if (not defined $locale->{$text})
434     {
435         print STDERR "Warning, \"$text\" not translated\n";
436         return $text;
437     }
438     return $locale->{$text};
439 }
440
441 sub getStrings
442 {
443     my $lang = shift;
444     my %strings = (
445     # STRINGS_BEGIN => start traduction section marker
446         fr => {
447             "Gtk-Fuser : a Gtk2 fuser Front-End" => "Gtk-Fuser : frontal pour fuser en Gtk2",
448             "Kill processes" => "Tuer les processus",
449             "Launch search" => "(Re)Lancer la recherche",
450             "File" => "Fichier",
451             "Directory" => "Répertoire",
452             "Path" => "Chemin",
453             "Can't open" => "Impossible d'ouvrir",
454             "Current directory" => "Répertoire courant",
455             "currently running" => "en cours d'exécution",
456             "Root directory" => "Répertoire racine",
457             "Can't open" => "Impossible d'ouvrir",
458             "- Process : " => "- Processus : ",
459             "- Owner : " => "- Propriétaire : ",
460             "Are you sure to want to kill " => "Êtes-vous sur de vouloir tuer ",
461             " processes ?" => " processus ?",
462             "processes still alive" => " processus toujours en vie",
463             "Operation succesfull" => "Opération réussie",
464             "Choose a file" => "Choisir un fichier",
465             "Choose a folder" => "Choisir un répertoire",
466         },
467     # STRINGS_END => end traduction section marker
468     );
469     return if $lang eq 'default' or not defined $strings{$lang};
470     return $strings{$lang};
471 }
472