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   21 use strict;
  3         6  
  3         120  
4 3     3   18 use warnings;
  3         6  
  3         111  
5              
6 3     3   15 use Carp;
  3         6  
  3         210  
7 3     3   18 use POSIX;
  3         6  
  3         21  
8 3     3   10497 use Data::Dumper;
  3         9  
  3         240  
9 3     3   21 use File::Basename;
  3         6  
  3         255  
10              
11 3     3   18 use System::Process;
  3         6  
  3         30  
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 15481 fork and exit;
76 2         154 POSIX::setsid();
77 2 100       12579 fork and exit;
78 1         71 umask 0;
79 1         49 chdir '/';
80 1         40 return 1;
81             }
82              
83              
84             sub pid_init {
85 1     1 0 4 my $pid = shift;
86              
87 1 50       15 croak "Can't init nothing" unless $pid;
88              
89 1 50       54 if (!-e $pid) {
90             # file does not exists, let's try to create
91 1         18 local *PID;
92 1 50       208 open PID, '>', $pid or do {
93 0         0 carp "Can't create pid $pid: $!";
94 0         0 return 0;
95             };
96              
97              
98 1         42 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 10 my ($pidfile, $pid, %owner) = @_;
108              
109 1   33     15 $pid ||= $$;
110              
111 1 50       3 croak "No pidfile" unless $pidfile;
112 1         4 local *PID;
113              
114 1         74 open PID, '>', $pidfile;
115 1         13 print PID $pid;
116 1         54 close PID;
117              
118 1 50 33     26 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         8 return 1;
127             }
128              
129              
130             sub read_pid {
131 4     4 0 10561 my ($pidfile) = @_;
132              
133 4 50       19 croak "No pidfile param" unless $pidfile;
134              
135 4 100       410 return 0 unless -e $pidfile;
136              
137 3         141 open PID, $pidfile;
138 3         73 my $pid = ;
139              
140 3 100       29 return 0 unless $pid;
141              
142 2         21 close PID;
143              
144 2         8 chomp $pid;
145              
146 2         12 my $res = validate_pid($pid);
147 2 50       10 return 0 unless $res;
148              
149 2         8 return $pid;
150             }
151              
152              
153             sub delete_pidfile {
154 2     2 0 4 my $pidfile = shift;
155            
156 2 100 50     121 unlink $pidfile or do {carp "$pidfile $!"} and return 0;
  1         600  
157              
158 1         9 return 1;
159             }
160              
161              
162             sub process_object {
163 4     4 0 8 my ($pid) = @_;
164              
165 4   33     52 $pid ||= $$;
166 4         37 return System::Process::pidinfo pid => $pid;
167             }
168              
169              
170             sub validate_pid_path {
171 1     1 0 12 my ($pidfile, $mkdir) = @_;
172              
173 1 50       7 croak unless $pidfile;
174              
175 1         167 my ($filename, $path) = fileparse ($pidfile);
176              
177             # path exists
178 1 50       62 if (-e $path) {
179             # path is not a directory
180 1 50       27 if (!-d $path) {
181 0         0 croak "Path '$path' exists and not a directory.";
182             }
183             # path exists and a directory
184 1         15 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 8 my ($pid) = @_;
198              
199 2 50       11 return 0 unless $pid;
200 2 50       32 if ($pid =~ m/^\d*$/s) {
201 2         7 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 52 open STDIN , '<', '/dev/null';
231 1         34 open STDOUT, '>', '/dev/null';
232 1         23 open STDERR, '>', '/dev/null';
233             }
234              
235              
236             1;
237              
238             __END__