File Coverage

blib/lib/System/Daemon/Utils.pm
Criterion Covered Total %
statement 73 127 57.4
branch 22 70 31.4
condition 4 17 23.5
subroutine 16 19 84.2
pod 0 12 0.0
total 115 245 46.9


line stmt bran cond sub pod time code
1             package System::Daemon::Utils;
2              
3 3     3   9 use strict;
  3         3  
  3         63  
4 3     3   9 use warnings;
  3         3  
  3         84  
5              
6 3     3   12 use Carp;
  3         3  
  3         165  
7 3     3   12 use POSIX;
  3         3  
  3         12  
8 3     3   4419 use Data::Dumper;
  3         3  
  3         114  
9 3     3   12 use File::Basename;
  3         0  
  3         132  
10              
11 3     3   9 use System::Process;
  3         3  
  3         15  
12              
13             our $DEBUG = 0;
14              
15             sub apply_rights {
16 0     0 0 0 my %params = @_;
17              
18 0 0       0 if ($params{group}) {
19 0         0 my $gid = getgrnam($params{group});
20 0 0       0 unless ($gid) {
21 0         0 croak "Group $params{group} does not exists.";
22             }
23 0 0       0 unless (setgid($gid)) {
24 0         0 croak "Can't setgid $gid: $!";
25             }
26             }
27              
28 0 0       0 if ($params{user}) {
29 0         0 my $uid = getpwnam($params{user});
30 0 0       0 unless ($uid) {
31 0         0 croak "User $params{user} does not exists.";
32             }
33 0 0       0 unless (setuid($uid)) {
34 0         0 croak "Can't setuid $uid: $!";
35             }
36             }
37 0         0 return 1;
38             }
39              
40              
41             sub validate_user_and_group {
42 0     0 0 0 my %params = @_;
43            
44 0         0 my $err = 0;
45              
46 0 0 0     0 if (!$params{user} && !$params{group}) {
47 0         0 croak "Missing user and group param, can't validate.";
48             }
49 0         0 my ($user, $group) = ($params{user}, $params{group});
50 0 0       0 if ($user) {
51 0         0 my $uid = getpwnam($user);
52 0 0       0 unless ($uid) {
53 0         0 carp "Wrong username";
54 0         0 $err++;
55             }
56             }
57              
58 0 0       0 if ($group) {
59 0         0 my $gid = getgrnam($group);
60 0 0       0 unless ($gid) {
61 0         0 carp "Wrong groupname";
62 0         0 $err++;
63             }
64             }
65              
66 0 0       0 if ($err) {
67 0         0 return 0;
68             }
69              
70 0         0 return 1;
71             }
72              
73              
74             sub daemon {
75 3 100   3 0 1174 fork and exit;
76 2         88 POSIX::setsid();
77 2 100       923 fork and exit;
78 1         33 umask 0;
79 1         15 chdir '/';
80 1         19 return 1;
81             }
82              
83              
84             sub pid_init {
85 1     1 0 2 my $pid = shift;
86              
87 1 50       8 croak "Can't init nothing" unless $pid;
88              
89 1 50       21 if (!-e $pid) {
90             # file does not exists, let's try to create
91 1         7 local *PID;
92 1 50       141 open PID, '>', $pid or do {
93 0         0 carp "Can't create pid $pid: $!";
94 0         0 return 0;
95             };
96              
97              
98 1         12 return 1;
99             }
100              
101             # Everything is ok, nothing to check
102 0         0 return 1;
103             }
104              
105              
106             sub write_pid {
107 1     1 0 8 my ($pidfile, $pid, %owner) = @_;
108              
109 1   33     8 $pid ||= $$;
110              
111 1 50       2 croak "No pidfile" unless $pidfile;
112 1         2 local *PID;
113              
114 1         40 open PID, '>', $pidfile;
115 1         13 print PID $pid;
116 1         33 close PID;
117              
118 1 50 33     10 if ($owner{user} || $owner{group}) {
119 0         0 my $uid = getpwnam($owner{user});
120 0         0 my $gid = getgrnam($owner{group});
121              
122 0 0       0 chown $uid, $gid, $pidfile or
123             croak "Can't chown $owner{user}:$owner{group}";
124             }
125              
126 1         4 return 1;
127             }
128              
129              
130             sub read_pid {
131 4     4 0 4781 my ($pidfile) = @_;
132              
133 4 50       14 croak "No pidfile param" unless $pidfile;
134              
135 4 100       61 return 0 unless -e $pidfile;
136              
137 3         58 open PID, $pidfile;
138 3         34 my $pid = ;
139              
140 3 100       19 return 0 unless $pid;
141              
142 2         12 close PID;
143              
144 2         3 chomp $pid;
145              
146 2         6 my $res = validate_pid($pid);
147 2 50       5 return 0 unless $res;
148              
149 2         7 return $pid;
150             }
151              
152              
153             sub delete_pidfile {
154 2     2 0 2 my $pidfile = shift;
155            
156 2 100 50     75 unlink $pidfile or do {carp "$pidfile $!"} and return 0;
  1         254  
157              
158 1         3 return 1;
159             }
160              
161              
162             sub process_object {
163 4     4 0 4 my ($pid) = @_;
164              
165 4   33     29 $pid ||= $$;
166 4         14 return System::Process::pidinfo pid => $pid;
167             }
168              
169              
170             sub validate_pid_path {
171 1     1 0 8 my ($pidfile, $mkdir) = @_;
172              
173 1 50       3 croak unless $pidfile;
174              
175 1         84 my ($filename, $path) = fileparse ($pidfile);
176              
177             # path exists
178 1 50       25 if (-e $path) {
179             # path is not a directory
180 1 50       12 if (!-d $path) {
181 0         0 croak "Path '$path' exists and not a directory.";
182             }
183             # path exists and a directory
184 1         4 return 1;
185             }
186              
187 0 0       0 if ($mkdir) {
188 0         0 return 1;
189             }
190              
191 0         0 croak "Path '$path' does not exists. Can't write PID.";
192              
193             }
194              
195              
196             sub validate_pid {
197 2     2 0 3 my ($pid) = @_;
198              
199 2 50       7 return 0 unless $pid;
200 2 50       16 if ($pid =~ m/^\d*$/s) {
201 2         5 return 1;
202             }
203 0         0 return 0;
204             }
205              
206              
207             sub make_sandbox {
208 0     0 0 0 my ($pidfile_full, $daemon_data) = @_;
209              
210 0 0       0 croak "Can't make sandbox without any data." unless $pidfile_full;
211              
212 0         0 my ($pidfile, $path) = fileparse($pidfile_full);
213              
214 0 0       0 if (-e $path) {
215 0         0 return 1;
216             }
217              
218 0 0       0 mkdir $path or croak "Can't 'mkdir $path' Error: $!";
219            
220 0 0 0     0 if ($daemon_data->{user} || $daemon_data->{group}) {
221 0         0 my $uid = getpwnam($daemon_data->{user});
222 0         0 my $gid = getgrnam($daemon_data->{group});
223 0         0 chown $uid, $gid, $path;
224             }
225 0         0 return 1;
226             }
227              
228              
229             sub suppress {
230 1     1 0 24 open STDIN , '<', '/dev/null';
231 1         13 open STDOUT, '>', '/dev/null';
232 1         9 open STDERR, '>', '/dev/null';
233             }
234              
235              
236             1;
237              
238             __END__