File Coverage

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


line stmt bran cond sub pod time code
1             package System::Daemon::Utils;
2              
3 3     3   18 use strict;
  3         3  
  3         144  
4 3     3   18 use warnings;
  3         3  
  3         66  
5              
6 3     3   9 use Carp;
  3         3  
  3         129  
7 3     3   9 use POSIX;
  3         3  
  3         15  
8 3     3   5211 use Data::Dumper;
  3         6  
  3         135  
9 3     3   12 use File::Basename;
  3         3  
  3         159  
10              
11 3     3   15 use System::Process;
  3         3  
  3         21  
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 2835 fork and exit;
76 2         174 POSIX::setsid();
77 2 100       1949 fork and exit;
78 1         43 umask 0;
79 1         24 chdir '/';
80 1         18 return 1;
81             }
82              
83              
84             sub pid_init {
85 1     1 0 5 my $pid = shift;
86              
87 1 50       4 croak "Can't init nothing" unless $pid;
88              
89 1 50       15 if (!-e $pid) {
90             # file does not exists, let's try to create
91 1         7 local *PID;
92 1 50       368 open PID, '>', $pid or do {
93 0         0 carp "Can't create pid $pid: $!";
94 0         0 return 0;
95             };
96              
97              
98 1         16 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 15 my ($pidfile, $pid, %owner) = @_;
108              
109 1   33     21 $pid ||= $$;
110              
111 1 50       2 croak "No pidfile" unless $pidfile;
112 1         2 local *PID;
113              
114 1         51 open PID, '>', $pidfile;
115 1         9 print PID $pid;
116 1         30 close PID;
117              
118 1 50 33     12 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         6 return 1;
127             }
128              
129              
130             sub read_pid {
131 2     2 0 8812 my ($pidfile) = @_;
132              
133 2 50       8 croak "No pidfile param" unless $pidfile;
134              
135 2 50       51 return 0 unless -e $pidfile;
136              
137 2         68 open PID, $pidfile;
138 2         41 my $pid = ;
139              
140 2 100       14 return 0 unless $pid;
141              
142 1         12 close PID;
143              
144 1         4 chomp $pid;
145              
146 1         4 my $res = validate_pid($pid);
147 1 50       5 return 0 unless $res;
148              
149 1         6 return $pid;
150             }
151              
152              
153             sub delete_pidfile {
154 2     2 0 4 my $pidfile = shift;
155            
156 2 100 50     71 unlink $pidfile or do {carp "$!"} and return 0;
  1         378  
157              
158 1         3 return 1;
159             }
160              
161              
162             sub process_object {
163 4     4 0 8 my ($pid) = @_;
164              
165 4   33     31 $pid ||= $$;
166 4         37 return System::Process::pidinfo pid => $pid;
167             }
168              
169              
170             sub validate_pid_path {
171 1     1 0 16 my ($pidfile, $mkdir) = @_;
172              
173 1 50       5 croak unless $pidfile;
174              
175 1         150 my ($filename, $path) = fileparse ($pidfile);
176              
177             # path exists
178 1 50       40 if (-e $path) {
179             # path is not a directory
180 1 50       15 if (!-d $path) {
181 0         0 croak "Path '$path' exists and not a directory.";
182             }
183             # path exists and a directory
184 1         16 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 1     1 0 4 my ($pid) = @_;
198              
199 1 50       7 return 0 unless $pid;
200 1 50       23 if ($pid =~ m/^\d*$/s) {
201 1         5 return 1;
202             }
203 0         0 return 0;
204             }
205              
206              
207             sub make_sandbox {
208 0     0 0 0 my ($daemon_data) = @_;
209            
210 0 0       0 croak "Can't make sandbox without any data." unless $daemon_data->{pidfile};
211              
212 0         0 my ($pidfile, $path) = fileparse($daemon_data->{pidfile});
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 34 open STDIN , '<', '/dev/null';
231 1         16 open STDOUT, '>', '/dev/null';
232 1         21 open STDERR, '>', '/dev/null';
233             }
234              
235              
236             1;
237              
238             __END__