File Coverage

lib/Ubic/Daemon/OS/Linux.pm
Criterion Covered Total %
statement 40 49 81.6
branch 6 12 50.0
condition n/a
subroutine 8 8 100.0
pod 4 4 100.0
total 58 73 79.4


line stmt bran cond sub pod time code
1             package Ubic::Daemon::OS::Linux;
2             $Ubic::Daemon::OS::Linux::VERSION = '1.59';
3 34     34   129 use strict;
  34         39  
  34         918  
4 34     34   116 use warnings;
  34         38  
  34         800  
5              
6             # ABSTRACT: linux-specific daemonize helpers
7              
8              
9 34     34   108 use POSIX;
  34         33  
  34         188  
10              
11 34     34   57312 use parent qw(Ubic::Daemon::OS);
  34         98  
  34         235  
12              
13             sub pid2guid {
14 5     5 1 20 my ($self, $pid) = @_;
15              
16 5 50       65 unless (-d "/proc/$pid") {
17 0         0 return; # process not found
18             }
19 5         170 my $opened = open(my $fh, '<', "/proc/$pid/stat");
20 5 50       20 unless ($opened) {
21             # open failed
22 0         0 my $error = $!;
23 0 0       0 unless (-d "/proc/$pid") {
24 0         0 return; # process exited right now
25             }
26 0         0 die "Open /proc/$pid/stat failed: $!";
27             }
28 5         205 my $line = <$fh>;
29             # cut first two fields (pid and process name)
30             # since process name can contain spaces, we can't just split line by \s+
31 5         55 $line =~ s/^\d+\s+\([^)]*\)\s+//;
32              
33 5         185 my @fields = split /\s+/, $line;
34 5         25 my $guid = $fields[19];
35 5         135 return $guid;
36             }
37              
38             sub pid2cmd {
39 5     5 1 10 my ($self, $pid) = @_;
40              
41 5         25 my $daemon_cmd_fh;
42 5 50       140 unless (open $daemon_cmd_fh, '<', "/proc/$pid/cmdline") {
43             # this can happen if pid got reused and now it belongs to the kernel process, e.g., [kthreadd]
44 0         0 warn "Can't open daemon's cmdline: $!";
45 0         0 return 'unknown';
46             }
47 5         115 my $daemon_cmd = <$daemon_cmd_fh>;
48 5 50       40 unless ($daemon_cmd) {
49             # strange, open succeeded but file is empty
50             # this can happen, though, for example if pid belongs to the kernel thread
51 0         0 warn "Can't read daemon cmdline";
52 0         0 return 'unknown';
53             }
54 5         65 $daemon_cmd =~ s/\x{00}$//;
55 5         35 $daemon_cmd =~ s/\x{00}/ /g;
56 5         45 close $daemon_cmd_fh;
57              
58 5         45 return $daemon_cmd;
59             }
60              
61             sub close_all_fh {
62 16     16 1 198 my ($self, @except) = @_;
63              
64 16         3832 my @fd_nums = map { s!^.*/!!; $_ } glob("/proc/$$/fd/*");
  114         917  
  114         409  
65 16         196 for my $fd (@fd_nums) {
66 114 100       227 next if grep { $_ == $fd } @except;
  114         637  
67 98         539 POSIX::close($fd);
68             }
69             }
70              
71             sub pid_exists {
72 5     5 1 15 my ($self, $pid) = @_;
73 5         110 return (-d "/proc/$pid");
74             }
75              
76             1;
77              
78             __END__