1#+############################################################################## 2# # 3# File: No/Worries/Stat.pm # 4# # 5# Description: stat() handling without worries # 6# # 7#-############################################################################## 8 9# 10# module definition 11# 12 13package No::Worries::Stat; 14use strict; 15use warnings; 16our $VERSION = "1.6"; 17our $REVISION = sprintf("%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/); 18 19# 20# used modules 21# 22 23use Fcntl qw(:mode); 24use No::Worries::Die qw(dief); 25use No::Worries::Export qw(export_control); 26use Params::Validate qw(validate :types); 27 28# 29# constants 30# 31 32use constant ST_DEV => 0; # ID of device containing file 33use constant ST_INO => 1; # inode number 34use constant ST_MODE => 2; # protection 35use constant ST_NLINK => 3; # number of hard links 36use constant ST_UID => 4; # user ID of owner 37use constant ST_GID => 5; # group ID of owner 38use constant ST_RDEV => 6; # device ID (if special file) 39use constant ST_SIZE => 7; # total size, in bytes 40use constant ST_ATIME => 8; # time of last access 41use constant ST_MTIME => 9; # time of last modification 42use constant ST_CTIME => 10; # time of last status change 43use constant ST_BLKSIZE => 11; # blocksize for filesystem I/O 44use constant ST_BLOCKS => 12; # number of 512B blocks allocated 45 46use constant _IMODE => oct(7777); # all mode bits 47use constant _IBITS => 12; # number of mode bits 48 49# 50# global variables 51# 52 53our( 54 @_Mode2Type, # mode (shifted) to file type 55 %_CachedUid, # cached uid from getpwnam() 56 %_CachedGid, # cached gid from getgrnam() 57); 58 59# 60# check user option and set uid and message accordingly 61# 62 63sub _check_user ($$) { 64 my($option, $message) = @_; 65 my($user); 66 67 $user = $option->{user}; 68 return unless defined($user); 69 if ($user =~ /^\d+$/) { 70 $option->{uid} = $user; 71 } else { 72 unless (exists($_CachedUid{$user})) { 73 $_CachedUid{$user} = getpwnam($user); 74 dief("unknown user: %s", $user) 75 unless defined($_CachedUid{$user}); 76 } 77 $option->{uid} = $_CachedUid{$user}; 78 } 79 $message->{user} = "user($user)"; 80} 81 82# 83# check group option and set gid and message accordingly 84# 85 86sub _check_group ($$) { 87 my($option, $message) = @_; 88 my($group); 89 90 $group = $option->{group}; 91 return unless defined($group); 92 if ($group =~ /^\d+$/) { 93 $option->{gid} = $group; 94 } else { 95 unless (exists($_CachedGid{$group})) { 96 $_CachedGid{$group} = getgrnam($group); 97 dief("unknown group: %s", $group) 98 unless defined($_CachedGid{$group}); 99 } 100 $option->{gid} = $_CachedGid{$group}; 101 } 102 $message->{group} = "group($group)"; 103} 104 105# 106# check the mode option and set mode_set, mode_clear and message accordingly 107# 108 109sub _check_mode ($$) { 110 my($option, $message) = @_; 111 my($mode, $action, $number); 112 113 $mode = $option->{mode}; 114 return unless defined($mode); 115 if ($mode =~ /^([\+\-])?(\d+)$/) { 116 $action = $1 || ""; 117 $number = substr($2, 0, 1) eq "0" ? oct($2) : ($2+0); 118 # use the canonical form for the message 119 $mode = sprintf("%s%05o", $action, $number); 120 if ($action eq "+") { 121 # check that at least these bits are set 122 $option->{mode_set} = $number; 123 $option->{mode_clear} = 0; 124 } elsif ($action eq "-") { 125 # check that at least these bits are cleared 126 $option->{mode_set} = 0; 127 $option->{mode_clear} = $number; 128 } else { 129 # check that these bits are exactly the ones set 130 $option->{mode_set} = $number; 131 $option->{mode_clear} = _IMODE; 132 } 133 } else { 134 dief("invalid mode: %s", $mode); 135 } 136 $message->{mode} = "mode($mode)"; 137} 138 139# 140# check the mtime option and set message accordingly 141# 142 143sub _check_mtime ($$) { 144 my($option, $message) = @_; 145 my($mtime); 146 147 $mtime = $option->{mtime}; 148 return unless defined($mtime); 149 $message->{mtime} = "mtime($mtime)"; 150} 151 152# 153# ensure proper ownership 154# 155 156sub _ensure_owner ($$$$) { 157 my($path, $stat, $option, $message) = @_; 158 my(@todo); 159 160 @todo = (); 161 if ($message->{user} and $stat->[ST_UID] != $option->{uid}) { 162 $stat->[ST_UID] = $option->{uid}; 163 push(@todo, $message->{user}); 164 } 165 if ($message->{group} and $stat->[ST_GID] != $option->{gid}) { 166 $stat->[ST_GID] = $option->{gid}; 167 push(@todo, $message->{group}); 168 } 169 return(0) unless @todo and $option->{callback}->($path, "@todo"); 170 chown($stat->[ST_UID], $stat->[ST_GID], $path) 171 or dief("cannot chown(%d, %d, %s): %s", 172 $stat->[ST_UID], $stat->[ST_GID], $path, $!); 173 return(1) 174} 175 176# 177# ensure proper permissions 178# 179 180sub _ensure_mode ($$$$) { 181 my($path, $stat, $option, $message) = @_; 182 my($mode); 183 184 $mode = $stat->[ST_MODE] & _IMODE; 185 $mode &= ~$option->{mode_clear}; 186 $mode |= $option->{mode_set}; 187 return(0) if ($stat->[ST_MODE] & _IMODE) == $mode; 188 return(0) unless $option->{callback}->($path, $message->{mode}); 189 chmod($mode, $path) 190 or dief("cannot chmod(%05o, %s): %s", $mode, $path, $!); 191 return(1) 192} 193 194# 195# ensure proper modification time 196# 197 198sub _ensure_mtime ($$$$) { 199 my($path, $stat, $option, $message) = @_; 200 201 return(0) if $stat->[ST_MTIME] == $option->{mtime}; 202 return(0) unless $option->{callback}->($path, $message->{mtime}); 203 utime($stat->[ST_ATIME], $option->{mtime}, $path) 204 or dief("cannot utime(%d, %d, %s): %s", 205 $stat->[ST_ATIME], $option->{mtime}, $path, $!); 206 return(1); 207} 208 209# 210# make sure the the file status is what is expected 211# 212 213my %stat_ensure_options = ( 214 user => { optional => 1, type => SCALAR, regex => qr/^[\w\-]+$/ }, 215 group => { optional => 1, type => SCALAR, regex => qr/^[\w\-]+$/ }, 216 mode => { optional => 1, type => SCALAR, regex => qr/^[\+\-]?\d+$/ }, 217 mtime => { optional => 1, type => SCALAR, regex => qr/^\d+$/ }, 218 follow => { optional => 1, type => BOOLEAN }, 219 callback => { optional => 1, type => CODEREF }, 220); 221 222sub stat_ensure ($@) { 223 my($path, %option, %message, @stat, $changed); 224 225 $path = shift(@_); 226 %option = validate(@_, \%stat_ensure_options) if @_; 227 _check_user(\%option, \%message); 228 _check_group(\%option, \%message); 229 _check_mode(\%option, \%message); 230 _check_mtime(\%option, \%message); 231 $option{callback} ||= sub { return(1) }; 232 dief("no options given") unless keys(%message); 233 if ($option{follow}) { 234 @stat = stat($path); 235 dief("cannot stat(%s): %s", $path, $!) unless @stat; 236 } else { 237 @stat = lstat($path); 238 dief("cannot lstat(%s): %s", $path, $!) unless @stat; 239 # we do not try to change symbolic links 240 return(undef) if -l _; 241 } 242 $changed = 0; 243 # first ensure owner 244 $changed += _ensure_owner($path, \@stat, \%option, \%message) 245 if $message{user} or $message{group}; 246 # then ensure mode 247 $changed += _ensure_mode($path, \@stat, \%option, \%message) 248 if $message{mode}; 249 # finally ensure mtime 250 $changed += _ensure_mtime($path, \@stat, \%option, \%message) 251 if $message{mtime}; 252 return($changed); 253} 254 255# 256# return the file type as a string from stat[ST_MODE] 257# 258 259sub stat_type ($) { 260 my($mode) = @_; 261 262 unless (@_Mode2Type) { 263 eval { $_Mode2Type[S_IFREG() >> _IBITS] = "plain file" }; 264 eval { $_Mode2Type[S_IFDIR() >> _IBITS] = "directory" }; 265 eval { $_Mode2Type[S_IFIFO() >> _IBITS] = "pipe" }; 266 eval { $_Mode2Type[S_IFSOCK() >> _IBITS] = "socket" }; 267 eval { $_Mode2Type[S_IFBLK() >> _IBITS] = "block device" }; 268 eval { $_Mode2Type[S_IFCHR() >> _IBITS] = "character device" }; 269 eval { $_Mode2Type[S_IFLNK() >> _IBITS] = "symlink" }; 270 eval { $_Mode2Type[S_IFDOOR() >> _IBITS] = "door" }; 271 eval { $_Mode2Type[S_IFPORT() >> _IBITS] = "event port" }; 272 eval { $_Mode2Type[S_IFNWK() >> _IBITS] = "network file" }; 273 eval { $_Mode2Type[S_IFWHT() >> _IBITS] = "whiteout" }; 274 } 275 $mode &= S_IFMT; 276 $mode >>= _IBITS; 277 return($_Mode2Type[$mode] || "unknown"); 278} 279 280# 281# export control 282# 283 284sub import : method { 285 my($pkg, %exported); 286 287 $pkg = shift(@_); 288 grep($exported{$_}++, grep(/^ST?_[A-Z]+$/, keys(%No::Worries::Stat::))); 289 grep($exported{$_}++, qw(stat_ensure stat_type)); 290 export_control(scalar(caller()), $pkg, \%exported, @_); 291} 292 2931; 294 295__DATA__ 296 297=head1 NAME 298 299No::Worries::Stat - stat() handling without worries 300 301=head1 SYNOPSIS 302 303 use No::Worries::Stat qw(*); 304 305 @stat = stat($path) or die; 306 printf("type is %s\n", stat_type($stat[ST_MODE])); 307 printf("size is %d\n", $stat[ST_SIZE]); 308 printf("user can read\n") if $stat[ST_MODE] & S_IRUSR; 309 310 # make sure "/bin/ls" is owned by root and has the right permissions 311 stat_ensure("/bin/ls", user => "root", mode => 0755); 312 # make sure "/var/log" is not group or world writable 313 stat_ensure("/var/log", mode => "-022"); 314 # idem but using the S_* constants 315 stat_ensure("/var/log", mode => "-" . (S_IWGRP|S_IWOTH)); 316 317=head1 DESCRIPTION 318 319This module eases file status handling by providing convenient constants and 320functions to get, set and manipulate file status information. All the 321functions die() on error. 322 323=head1 CONSTANTS 324 325This module provides the following constants to ease access to stat() fields 326(none of them being exported by default): 327 328=over 329 330=item C<ST_DEV> 331 332ID of device containing file 333 334=item C<ST_INO> 335 336inode number 337 338=item C<ST_MODE> 339 340protection 341 342=item C<ST_NLINK> 343 344number of hard links 345 346=item C<ST_UID> 347 348user ID of owner 349 350=item C<ST_GID> 351 352group ID of owner 353 354=item C<ST_RDEV> 355 356device ID (if special file) 357 358=item C<ST_SIZE> 359 360total size, in bytes 361 362=item C<ST_ATIME> 363 364time of last access 365 366=item C<ST_MTIME> 367 368time of last modification 369 370=item C<ST_CTIME> 371 372time of last status change 373 374=item C<ST_BLKSIZE> 375 376blocksize for filesystem I/O 377 378=item C<ST_BLOCKS> 379 380number of 512B blocks allocated 381 382=back 383 384In addition, it also optionally exports all the ":mode" constants from L<Fcntl>. 385 386This way, all the stat() related constants can be imported in a uniform way. 387 388=head1 FUNCTIONS 389 390This module provides the following functions (none of them being 391exported by default): 392 393=over 394 395=item stat_type(MODE) 396 397given the file mode (C<ST_MODE> field), return the file type as a string; 398possible return values are: "block device", "character device", "directory", 399"door", "event port", "network file", "pipe", "plain file", "socket", 400"symlink", "unknown" and "whiteout". 401 402=item stat_ensure(PATH[, OPTIONS]) 403 404make sure the given path has the expected file "status" (w.r.t. stat()) and 405call chown(), chmod() or utime() if needed, returning the number of changes 406performed; supported options: 407 408=over 409 410=item * C<user>: expected user name or uid 411 412=item * C<group>: expected group name or gid 413 414=item * C<mode>: expected mode specification (see below) 415 416=item * C<mtime>: expected modification time 417 418=item * C<follow>: follow symbolic links (default is to skip them) 419 420=item * C<callback>: code to be executed before changing something (see below) 421 422=back 423 424=back 425 426The C<mode> option of stat_ensure() can be given: 427 428=over 429 430=item I<NUMBER> 431 432an absolute value like 0755, meaning that mode must be equal to it 433 434=item +I<NUMBER> 435 436a list of bits that must be set, e.g. "+0111" for "executable for all" 437 438=item -I<NUMBER> 439 440a list of bits that must be clear, e.g. "-022" for not writable by group or 441other 442 443=back 444 445Note: the number after "+" or "-" will be interpreted as being octal only if 446it starts with "0". You should therefore use "+0111" or "+".oct(111) to 447enable the executable bits but not "+111" which is the same as "+0157". 448 449The C<callback> option of stat_ensure() will receive the given path and a 450string describing what is about to be changed. It must return true to tell 451stat_ensure() to indeed perform the changes. 452 453Here is for insatnce how a "noaction" option could be implemented: 454 455 sub noaction ($$) { 456 my($path, $change) = @_; 457 458 printf("did not change %s of %s\n", $change, $path); 459 return(0); 460 } 461 foreach my $path (@paths) { 462 stat_ensure($path, user => "root", mode => 0755, callback => \&noaction); 463 } 464 465=head1 SEE ALSO 466 467L<Fcntl>, 468L<No::Worries>. 469 470=head1 AUTHOR 471 472Lionel Cons L<http://cern.ch/lionel.cons> 473 474Copyright (C) CERN 2012-2019 475