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.58_01'; # TRIAL
3 36     36   187 use strict;
  36         75  
  36         1266  
4 36     36   192 use warnings;
  36         71  
  36         1360  
5              
6             # ABSTRACT: linux-specific daemonize helpers
7              
8              
9 36     36   185 use POSIX;
  36         43  
  36         283  
10              
11 36     36   92390 use parent qw(Ubic::Daemon::OS);
  36         65  
  36         288  
12              
13             sub pid2guid {
14 5     5 1 10 my ($self, $pid) = @_;
15              
16 5 50       70 unless (-d "/proc/$pid") {
17 0         0 return; # process not found
18             }
19 5         100 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         190 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         45 $line =~ s/^\d+\s+\([^)]*\)\s+//;
32              
33 5         100 my @fields = split /\s+/, $line;
34 5         10 my $guid = $fields[19];
35 5         50 return $guid;
36             }
37              
38             sub pid2cmd {
39 5     5 1 15 my ($self, $pid) = @_;
40              
41 5         20 my $daemon_cmd_fh;
42 5 50       245 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         120 my $daemon_cmd = <$daemon_cmd_fh>;
48 5 50       20 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         45 $daemon_cmd =~ s/\x{00}$//;
55 5         25 $daemon_cmd =~ s/\x{00}/ /g;
56 5         30 close $daemon_cmd_fh;
57              
58 5         40 return $daemon_cmd;
59             }
60              
61             sub close_all_fh {
62 19     19 1 235 my ($self, @except) = @_;
63              
64 19         6968 my @fd_nums = map { s!^.*/!!; $_ } glob("/proc/$$/fd/*");
  136         1325  
  136         490  
65 19         242 for my $fd (@fd_nums) {
66 136 100       263 next if grep { $_ == $fd } @except;
  136         1000  
67 117         727 POSIX::close($fd);
68             }
69             }
70              
71             sub pid_exists {
72 5     5 1 10 my ($self, $pid) = @_;
73 5         145 return (-d "/proc/$pid");
74             }
75              
76             1;
77              
78             __END__