line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MMM::Utils; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
872
|
use strict; |
|
4
|
|
|
|
|
9
|
|
|
4
|
|
|
|
|
165
|
|
4
|
4
|
|
|
4
|
|
24
|
use warnings; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
143
|
|
5
|
|
|
|
|
|
|
|
6
|
4
|
|
|
4
|
|
23
|
use base qw(Exporter); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
526
|
|
7
|
4
|
|
|
4
|
|
3986
|
use Date::Calc qw(Delta_YMDHMS); |
|
4
|
|
|
|
|
162271
|
|
|
4
|
|
|
|
|
5442
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
our @EXPORT = qw( |
10
|
|
|
|
|
|
|
yes_no |
11
|
|
|
|
|
|
|
fmt_duration |
12
|
|
|
|
|
|
|
duration2m |
13
|
|
|
|
|
|
|
); |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
=head1 NAME |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
MMM::Utils |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
=head1 METHODS |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head2 yes_no($val) |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Parse $val to return true or false |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=cut |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub yes_no { |
28
|
9
|
|
|
9
|
1
|
541
|
my ($val) = @_; |
29
|
9
|
|
100
|
|
|
30
|
$val ||= ''; |
30
|
9
|
100
|
66
|
|
|
64
|
if ($val =~ /^(yes|true|on|\d+)$/i && $val ne 0) { |
31
|
4
|
|
|
|
|
18
|
return 1; |
32
|
|
|
|
|
|
|
} else { |
33
|
5
|
|
|
|
|
24
|
return 0; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
} |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub _get_meantime { |
38
|
8
|
|
|
8
|
|
11
|
my ($time) = @_; |
39
|
8
|
|
|
|
|
40
|
my ($Second, $Minute, $Hour, $Day, $Month, |
40
|
|
|
|
|
|
|
$Year, $WeekDay, $DayOfYear, $IsDST) = gmtime($time); |
41
|
8
|
|
|
|
|
15
|
$Year+=1900; $Month+=1; |
|
8
|
|
|
|
|
9
|
|
42
|
8
|
|
|
|
|
27
|
return ($Year, $Month, $Day, $Hour, $Minute, $Second); |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=head2 fmt_duration($second) |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
Transform a duration in second to a string in form of |
48
|
|
|
|
|
|
|
day/hours/minutes/seconds. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=cut |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
sub fmt_duration { |
53
|
4
|
|
|
4
|
1
|
9
|
my ($second1, $second2) = @_; |
54
|
4
|
|
|
|
|
8
|
my @gmt1 = _get_meantime($second1); |
55
|
4
|
|
50
|
|
|
19
|
my @gmt2 = _get_meantime($second2 || scalar(time)); |
56
|
|
|
|
|
|
|
|
57
|
4
|
50
|
|
|
|
21
|
my ($D_y,$D_m,$D_d, $Dh,$Dm,$Ds) = Delta_YMDHMS( |
58
|
|
|
|
|
|
|
$second1 <= $second2 |
59
|
|
|
|
|
|
|
? (@gmt1, @gmt2) |
60
|
|
|
|
|
|
|
: (@gmt2, @gmt1) |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
|
63
|
16
|
100
|
|
|
|
48
|
return join(', ', grep { $_ } ( |
|
12
|
|
|
|
|
55
|
|
64
|
|
|
|
|
|
|
$D_y ? sprintf('%d year%s' , $D_y, $D_y > 1 ? 's' : '') : '', |
65
|
|
|
|
|
|
|
$D_m ? sprintf('%d month%s' , $D_m, $D_m > 1 ? 's' : '') : '', |
66
|
|
|
|
|
|
|
$D_d ? sprintf('%d day%s' , $D_d, $D_d > 1 ? 's' : '') : '', |
67
|
4
|
0
|
|
|
|
412
|
sprintf ("%02dh%02dm%02ds", map { $_ || 0 } ($Dh, $Dm, $Ds)), |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
68
|
|
|
|
|
|
|
) |
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=head2 duration2m($duration) |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
Return in minutes a human readable value like 2d or 3h |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
=cut |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
sub duration2m { |
80
|
0
|
|
|
0
|
1
|
0
|
my ($v) = @_; |
81
|
0
|
0
|
|
|
|
0
|
if (my ($n, $u) = $v =~ /^(\d+)(\D)?/) { |
82
|
0
|
|
0
|
|
|
0
|
for (lc($u || 'm')) { |
83
|
0
|
0
|
|
|
|
0
|
/m/ and return $n; |
84
|
0
|
0
|
|
|
|
0
|
/h/ and return $n * 60; |
85
|
0
|
0
|
|
|
|
0
|
/d/ and return $n * 60 * 24; |
86
|
0
|
0
|
|
|
|
0
|
/w/ and return $n * 60 * 24 * 7; |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
} |
89
|
0
|
|
|
|
|
0
|
return $v; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=head2 setid($user, $group) |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Change effective user and group to $user and optionnal $group. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
Return arrayref containning old uid and gid on success. Return undef and |
97
|
|
|
|
|
|
|
error message on failure. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
=cut |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub setid { |
102
|
2
|
|
|
2
|
1
|
69
|
my ($user, $group) = @_; |
103
|
|
|
|
|
|
|
|
104
|
2
|
|
|
|
|
4
|
my ($uid, $gid); |
105
|
|
|
|
|
|
|
|
106
|
2
|
0
|
0
|
|
|
6
|
if ($user |
|
|
|
33
|
|
|
|
|
107
|
|
|
|
|
|
|
&& ($> == 0 || $< == 0)) { # if we're not root, we can only ignore this |
108
|
0
|
0
|
|
|
|
0
|
if ($user =~ /^\d+$/) { |
109
|
0
|
|
|
|
|
0
|
$uid = $user; |
110
|
0
|
|
|
|
|
0
|
my @uinfo = POSIX::getpwuid($uid); |
111
|
0
|
0
|
|
|
|
0
|
if (!scalar(@uinfo)) { |
112
|
0
|
|
|
|
|
0
|
return(undef, sprintf('User %s don\'t exists', $uid)); |
113
|
|
|
|
|
|
|
} |
114
|
0
|
|
|
|
|
0
|
$gid = $uinfo[3]; |
115
|
|
|
|
|
|
|
} else { |
116
|
0
|
|
|
|
|
0
|
my @uinfo = POSIX::getpwnam($user); |
117
|
0
|
0
|
|
|
|
0
|
if (scalar(@uinfo)) { |
118
|
0
|
|
|
|
|
0
|
($uid, $gid) = ($uinfo[2], $uinfo[3]); |
119
|
0
|
|
|
|
|
0
|
$group = $uinfo[3]; |
120
|
|
|
|
|
|
|
} else { |
121
|
0
|
|
|
|
|
0
|
return(undef, sprintf('User %s don\'t exists', $user)); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
} |
125
|
2
|
50
|
|
|
|
5
|
if ($group) { |
126
|
0
|
0
|
|
|
|
0
|
if ($group =~ /^\d+$/) { |
127
|
0
|
|
|
|
|
0
|
$gid = $group; |
128
|
|
|
|
|
|
|
} else { |
129
|
0
|
|
|
|
|
0
|
my @ginfo = POSIX::getgrnam($group); |
130
|
0
|
0
|
|
|
|
0
|
if (scalar(@ginfo)) { |
131
|
0
|
|
|
|
|
0
|
$gid = $ginfo[2]; |
132
|
|
|
|
|
|
|
} else { |
133
|
0
|
|
|
|
|
0
|
return(undef, sprintf('group %s don\'t exists', $group)); |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
2
|
|
|
|
|
7
|
my ($ouid, $ogid) = _setid($uid, $gid); |
139
|
|
|
|
|
|
|
|
140
|
2
|
50
|
|
|
|
7
|
if(!defined($ogid)) { |
141
|
0
|
|
|
|
|
0
|
return (undef, sprintf('Cannot change to group %s', $group)); |
142
|
|
|
|
|
|
|
} |
143
|
2
|
50
|
|
|
|
5
|
if (!defined($ouid)) { |
144
|
0
|
|
|
|
|
0
|
return (undef, sprintf('Cannot become user %s', $user)); |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
2
|
|
|
|
|
7
|
return([$ouid, $ogid]); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub _setid { |
153
|
2
|
|
|
2
|
|
3
|
my ($uid, $gid) = @_; |
154
|
2
|
|
|
|
|
23
|
my ($olduid, $oldgid) = ($>, $)); |
155
|
2
|
50
|
33
|
|
|
6
|
if (defined($gid) && $) != $gid) { |
156
|
0
|
|
|
|
|
0
|
$) = $gid; |
157
|
0
|
0
|
|
|
|
0
|
if ($) != $gid) { |
158
|
0
|
|
|
|
|
0
|
$oldgid = undef; |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
} |
161
|
2
|
50
|
33
|
|
|
7
|
if (defined($uid) && $> != $uid) { |
162
|
0
|
|
|
|
|
0
|
$> = $uid; |
163
|
0
|
0
|
|
|
|
0
|
if ($> != $uid) { |
164
|
0
|
|
|
|
|
0
|
$olduid = undef; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
2
|
|
|
|
|
6
|
return($olduid, $oldgid); |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head1 AUTHOR |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Olivier Thauvin |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=cut |