#!/usr/bin/perl $ID = q$Id: bundle,v 2.31 2008-10-06 01:18:35 eagle Exp $; # # bundle -- Maintains a "bundle" of files. # # Originally written by Roland Schemers # Some modifications by Larry Schwimmer # Rewritten and updated by Russ Allbery # Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, 2006, # 2008 Board of Trustees, Leland Stanford Jr. University # # This program is free software; you may redistribute it and/or modify it # under the same terms as Perl itself. # # One special point should be noticed when reading or modifying any of the # following code: This script makes *extensive* use of the special _ file # handle in file tests. _ holds the stat information from the previous file # test, stat, or lstat, and therefore it's absolutely vital to always pay # attention whenever stating or testing something to make sure one doesn't # modify the expected contents of _. # # Also as a result of this, this code does a lot of apparently unnecessary -l # file tests. For example, rather than simply checking for existence of a # file with -e $file, we do (-l $file || -e _) instead. This is because if # $file is a dangling symbolic link, -e $file will return *false* even though # something *does* exist, because it will do a stat and try to follow the # symlink. We do a -l first to force an lstat and then use the results of # that for the existence check. Be very careful to always follow this idiom # and be aware of dangling symbolic links and how they affect the results of # your file tests. # # (It's arguable if this is the best programming style; one option would be to # always do an explicit lstat before any file tests so as to make the hidden # behavior more obvious. This works, however, and it's actually a fairly easy # idiom to fall into if one is actively thinking about what's going on.) # # It's also worth noting that currently the subs in this file are ordered # largely by dependency and reordering them may break things. Predeclarations # would probably be a good idea someday.... # # Remember to always chown before chmod, since if the target permissions # include setuid or setgid bits, chown may clear those bits. ############################################################################## # Site configuration ############################################################################## # The default directory in which to look for bundle files. By default, this # can be overriden by setting BUNDLE_LIB. Note that . is *not* searched # unless it's one of the paths in the library. $LIBRARY = $ENV{BUNDLE_LIB} || '.:/usr/pubsw/lib/bundle'; # The full path to the program, used to find itself to feed itself to perldoc. $FULLPATH = $0; $0 =~ s%.*/%%; ############################################################################## # Modules and declarations ############################################################################## # We want File::stat and the bundling ability in Getopt::Long, plus we need # sysseek which wasn't added until 5.004. This means we can use constructs # like for my $var. require 5.004; use Fcntl qw(O_APPEND O_CREAT O_EXCL O_RDWR O_RDONLY O_WRONLY); use File::Copy qw(copy move); use File::stat qw(stat lstat); use Getopt::Long qw(GetOptions); use strict; use vars qw(%CONFIG $FILE $FULLPATH $ID $LIBRARY %OVERRIDE %REPORTED); use subs qw(set); ############################################################################## # Utility functions ############################################################################## # Prints out a given string if and only if debugging is enabled. sub debug { print (@_, "\n") if $CONFIG{debug} } # Return the first element of a list that's defined. sub first_defined { for (@_) { return $_ if defined } undef } # Given either a UID or a username, convert it to a UID and return it. sub name2uid { my $user = shift; return if (!defined $user || $user eq ''); return $user if ($user =~ /^-?\d+$/); my $uid = getpwnam $user; die "$0: can't find UID for $user\n" unless defined $uid; $uid; } # Given either a GID or a group, convert it to a GID and return it. sub name2gid { my $group = shift; return undef if (!defined $group || $group eq ''); return $group if ($group =~ /^-?\d+$/); my $gid = getgrnam $group; die "$0: can't find GID for $group\n" unless defined $gid; $gid; } ############################################################################## # Initialization ############################################################################## # Read any command line options into the %CONFIG array. Command line options # should override options set in bundle files. sub read_options { my @options = ( 'backup|b', # save backout information 'changes|c', # show changes with diff 'cwd|C=s', # change working directory 'debug|d', # print debugging information 'define|D=s%', # define a variable to a value 'force|f', # update even unchanged files 'help|h', # print usage and exit 'just-print|dry-run|n', # just print what would be done 'quiet|q', # don't print actions 'source|s', # report source file location 'up-to-date|u', # report files that are fine 'younger|y', # only update if younger 'version|v' # print version and exit ); # Actually get the options, after setting a couple of defaults. Getopt::Long::config ('bundling', 'no_ignore_case', 'no_getopt_compat'); GetOptions (\%CONFIG, @options) or exit 1; # Act on a few things special options. if ($CONFIG{help}) { print "Feeding myself to perldoc, please wait....\n"; exec ('perldoc', '-t', $FULLPATH) or die "$0: can't fork: $!\n"; } elsif ($CONFIG{version}) { my $version = join (' ', (split (' ', $ID))[1..3]); $version =~ s/,v\b//; $version =~ s/(\S+)$/($1)/; $version =~ tr%/%-%; print $version, "\n"; exit; } # Handle variable declarations. if ($CONFIG{define}) { for (keys %{$CONFIG{define}}) { set ($_, $CONFIG{define}{$_}); $OVERRIDE{$_} = 1; } } # Make sure they don't feed us bogus combinations. if ($CONFIG{force} && $CONFIG{younger}) { die "$0: -f (--force) conflicts with -y (--younger)\n"; } # A few options imply other options. if ($CONFIG{'debug'}) { $CONFIG{'up-to-date'} = 1 } if ($CONFIG{'changes'}) { $CONFIG{'just-print'} = 1 } } # Locate a bundle file, doing a search for it in the bundle library if # necessary. Takes in a filename to find and returns either the full path or # a relative path if the file was found in the current directory, or undef if # the file wasn't found. If the provided filename is already an absolute # path, no library search is done. Note that the current directory is *not* # searched unless it is explicitly included in the path (it's in the default # path). The filename is checked for with .b added if it doesn't already end # in .b. Only regular files are checked for. sub find_bundle { my $file = shift; my $dotb = ($file =~ /\.b$/); if ($file =~ m%^/%) { return $file if (-f $file); return "$file.b" if (!$dotb && -f "$file.b"); } else { foreach (split (/:/, $LIBRARY)) { return "$_/$file" if (-f "$_/$file"); return "$_/$file.b" if (!$dotb && -f "$_/$file.b"); } } undef; } ############################################################################## # Parsing ############################################################################## # Does variable interpolation, warning if we attempt to interpolate an # undefined variable. sub interpolate { local $_ = shift; my $subst = sub { my $variable = shift; if ($variable !~ /^[a-z0-9]+$/ && defined $CONFIG{$variable}) { return $CONFIG{$variable}; } else { die "$0:$FILE:$.: Unknown variable \$$variable\n"; } }; # We want to do variable substitution in a single regex match so that we # don't accidentally interpolate more than once, but under the regex # syntax of 5.004 and earlier I can't find a way to do that. See the # comments in the 5.005 version to understand what's going on here. # Annoyingly, we can't just include the 5.005 regex, since even under # 5.004 Perl tries to compile it. I work around that by putting the # problematic part in a variable. if ($] < 5.005) { s/((?:^|\G|[^\\\$])(?:\\\\)*)\$(\w+)/$1 . &$subst ($2)/ges; s/((?:^|\G|[^\\\$])(?:\\\\)*)\$\{(\w+)\}/$1 . &$subst ($2)/ges; } else { my $closebrace = '(?(2)\})'; s/((?: # Anchor at ^ # ...either the beginning of the string... |\G # ...where the last substitution left off... |[^\\\$] # ...or something other than a \ or $, ) # followed by... (?:\\\\)* # ...an even number of backslashes, ) # and remember all that (1). # The point of all of the above is to make sure that the next # character is not escaped by a backslash, which (since backslashes # can be escaped by backslashes) is actually somewhat tricky. But now # that we've done that work, we can, with confidence, match an... \$ # ...unescaped $, beginning a variable name (\{)? # ...which may be in curly braces (2) (\w+) # The variable name (3) that we'll use. $closebrace # The close curly, iff we had an open curly. / # Replace with.... $1 . &$subst ($3) # ...the leading stuff & the variable value, /gesxo; # globally, across newlines. } $_; } # Parses a single line, splitting it on whitespace, and returns the resulting # array. Double quotes are supported for arguments that have embedded # whitespace, and backslashes escape the next character (whatever it is). We # can't use Text::ParseWords because it's too smart for its own good. A parse # failure is considered a fatal error. sub parse_line { my $line = shift; my (@args, $snippet); while ($line ne '') { $line =~ s/^\s+//; $snippet = ''; while ($line !~ /^\s/ && $line ne '') { my $tmp; if (index ($line, "'") == 0) { $line =~ s/^\'((?:[^\'\\]|\\.)*)\'//s or die "$0:$FILE:$.: Unbalanced quotes\n"; ($tmp = $1) =~ s/\\([\'\\])/$1/g; } elsif (index ($line, '"') == 0) { $line =~ s/^\"((?:[^\"\\]|\\.)*)\"//s or die "$0:$FILE:$.: Unbalanced quotes\n"; ($tmp = interpolate $1) =~ s/\\(.)/$1/gs; } else { $line =~ s/^((?:[^\\\"\'\s]|\\.)+)//s; ($tmp = interpolate $1) =~ s/\\(.)/$1/gs; } $snippet .= $tmp; } push (@args, $snippet); } @args; } # Set a variable to a given value, doing the necessary checks to ensure that # the assignment is valid and that reserved variables aren't being assigned # to. The allowable special variables are: # # owner Created files set to that owner. # group Created files set to that group. # mode Created files given that mode. # system Command is run on successful completion of line. # force Force updates even if nothing has (apparently) changed. # younger Only update if the source file is younger. # atime Set the atime of files and directories to this. # mtime Set the mtime of files and directories to this. # # All other all-lowercase variables are reserved and cannot be assigned to. sub set { debug "set: @_"; my ($var, $value, $commandline) = @_; # First off, check to see if a command line setting overrode. if ($OVERRIDE{$var} && $. > 0) { debug " overridden by command line, ignoring"; return; } # Some variables are special. All all-lowercase variables are reserved # for bundle internal use. if ($var eq 'owner') { $CONFIG{uid} = name2uid $value } elsif ($var eq 'group') { $CONFIG{gid} = name2gid $value } elsif ($var eq 'mode') { $CONFIG{mode} = oct $value } elsif ($var eq 'system') { $CONFIG{'system'} = $value } elsif ($var eq 'force') { $CONFIG{force} = $value } elsif ($var eq 'younger') { $CONFIG{younger} = $value } elsif ($var eq 'atime') { $CONFIG{atime} = $value } elsif ($var eq 'mtime') { $CONFIG{mtime} = $value } elsif ($var =~ /^[a-z0-9]+$/) { my $intro = ($. > 0 ? "$0:$FILE:$." : $0); die "$intro: Assignment to reserved variable $var\n"; } else { $CONFIG{$var} = $value; } # They may have changed force or younger, so do another sanity check. if ($CONFIG{force} && $CONFIG{younger}) { my $intro = ($. > 0 ? "$0:$FILE:$." : $0); die "$intro: force conflicts with younger\n"; } # Setting a variable to the empty string undefines it, and if we've gotten # this far, we've set a variable. (uid and gid are handled separately, so # skip owner and group.) Code structure here is a bit annoying, but this # is the simplest way to write this. if ($value eq '' && $var ne 'owner' && $var ne 'group') { undef $CONFIG{$var}; } } # Given the name of a sub to run, the number of arguments it expects, and the # parsed command line, take the trailing part of the command line and parse # out any variable settings and then pass the arguments to the sub and return # whatever the sub returns. We can catch syntax errors here, and we are # guaranteed to have an accurate $. variable. sub run { my ($sub, $args, @line) = @_; my @args; if (defined $args) { if (@line < $args) { die "$0:$FILE:$.: Insufficient arguments\n" } @args = splice (@line, 0, $args); } else { @args = @line; undef @line; } if (@line) { local %CONFIG = %CONFIG; for (@line) { /^(\w+)=(.*)/ or die "$0:$FILE:$.: Syntax error in $_\n"; set ($1 => $2); } # Call the sub from here so that it gets the localized %CONFIG. &$sub (@args); } else { &$sub (@args); } } ############################################################################## # Reporting and output ############################################################################## # Run diff on two files and print out the results, if they're fewer than 100 # lines. If more than 100 lines, print out the header and then a note that # the diff itself has been suppressed. sub diff { my ($first, $second) = @_; my $pid = open (DIFF, '-|'); if (!defined $pid) { die "$0: cannot fork: $!\n"; } elsif ($pid == 0) { open (STDERR, '>&STDOUT') or die "$0: cannot send stderr to stdout: $!\n"; exec ('diff', '-u', $first, $second) or die "$0: cannot exec diff: $!\n"; } my @diff = ; close DIFF; # Trim off the fractional seconds on the time to make the lines shorter. for (@diff[0,1]) { s/\.\d{5,} -/ -/; } # Print out the diff output if it's 100 lines or less. Otherwise, print # out just the header and a note that it was suppressed. if (@diff > 100) { print @diff[0,1]; print "Large diff output (", scalar (@diff), " lines) suppressed\n"; } else { print @diff; } } # Report on an action, changing the message if we were told to just print, and # suppressing the message if we were told to be quiet. sub report { return if $CONFIG{quiet}; my ($message, $destination, $source, $undo) = @_; if (defined $destination) { if ($CONFIG{'just-print'}) { $message = 'need to ' . $message; } else { $message =~ s/^(\w+?)e?\b/$1ing/; } print "$message $destination\n"; print " source: $source\n" if ($source && $CONFIG{source}); if ($message eq 'need to update' && $CONFIG{changes} && $source) { diff ($destination, $source); } } else { print $message, "\n"; } } # Report a change that didn't happen because the destination was okay. sub okay { return unless $CONFIG{'up-to-date'}; my ($destination, $source) = @_; print "ok: $destination\n"; print " source: $source\n" if ($source && $CONFIG{source}); } # Print out undo information for a generic command, escaping the file name as # appropriate. We have to actually go to some lengths to correctly escape a # newline in a file. sub save_command { return unless $CONFIG{backup}; my ($command, @files) = @_; for (@files) { s/([\\\"\'\$\s])/\\$1/g; s/(\\\n)/\'$1\'/g } print " undo: $command @files\n"; } # Print out undo information for a chmod. sub save_chmod { return unless $CONFIG{backup}; my ($mode, $file) = @_; save_command (sprintf ('chmod %o', $mode & 07777), $file); } # Print out undo information for a chown. sub save_chown { return unless $CONFIG{backup}; my ($uid, $gid, $file) = @_; save_command ("chown $uid $gid", $file); } ############################################################################## # Overloaded functions ############################################################################## # We overload a series of core functions so that error reporting happens # automatically. Note that in the process we restrict these builtins to # taking only one file at a time. use subs qw(chmod chown mkdir symlink utime); sub chmod { my $status = CORE::chmod ($_[0], $_[1]); unless ($status) { warn "$0: chmod $_[1] failed: $!\n" } $status; } sub mkdir { my $status = CORE::mkdir ($_[0], $_[1]); unless ($status) { warn "$0: mkdir $_[0] failed: $!\n" } $status; } # Some platforms do odd things with symlink() permissions, so although this # shouldn't matter, make sure our umask is 0 when we create a symlink. sub symlink { my $umask = umask 0; my $status = CORE::symlink ($_[0], $_[1]); unless ($status) { warn "$0: symlink $_[1] failed: $!\n" } umask $umask; $status; } # Make life a little easier on ourselves by allowing either of the arguments # to be undef, in which case we set the time to the same as the current time # (obtained by stating the file). sub utime { my ($atime, $mtime, $file) = @_; unless (defined $atime && defined $mtime) { my $stats = lstat $file; if (defined $stats) { $atime = first_defined ($atime, $stats->atime); $mtime = first_defined ($mtime, $stats->mtime); } else { warn "$0: unable to stat $file: $!\n"; return; } } my $status = CORE::utime ($atime, $mtime, $file); unless ($status) { warn "$0: utime $file failed: $!\n" } $status; } # chown is a little special. Basically, unless we're root, we don't want to # change the owner if the owner is the same as our current effective UID. # Otherwise, we get an error that doesn't actually mean anything. We also # don't want to actually run chown if we're changing neither the UID nor the # GID of the file. sub chown { my ($uid, $gid, $file) = @_; $uid = first_defined (($> != 0 && $uid == $>) ? -1 : $uid, -1); $gid = first_defined ($gid, -1); if ($uid == -1 && $gid == -1) { return 1 } my $status = CORE::chown ($uid, $gid, $file); unless ($status) { warn "$0: chown $file failed: $!\n" } $status; } ############################################################################## # Auxilliary functions for bundle commands ############################################################################## # Runs $CONFIG{system}, substituting the source file (if given) for %S and the # destination file (if given) for %D. sub command { return unless $CONFIG{'system'}; debug "command: @_"; my ($source, $destination) = @_; my $command = $CONFIG{'system'}; $command =~ s/%S/$source/g if $source; $command =~ s/%D/$destination/g if $destination; report ('execute', $command); unless ($CONFIG{'just-print'}) { system $command; unless ($? == 0) { warn "$0: $command returned exit status $?\n" } save_command ('# ran system', $command); } } # Creates a chain of directories as necessary so that a final destination # directory exists. Note that we're assuming Unix path separators here, just # in case it ever eventually matters. We optionally take a passed owner, # group, and mode, and take the UID and GID to use from either that or # %CONFIG. The default mode, if none is given, is 0755 modified by umask. # Returns 1 on success (or nothing to do), undef on some failure. sub mkdir_chain { my ($path, $owner, $group, $mode) = @_; debug "mkdir_chain: @_"; # Figure out the owner, group, and mode to use. $owner = first_defined ($owner, $CONFIG{uid}); $group = first_defined ($group, $CONFIG{gid}); $mode = first_defined ($mode, $CONFIG{mode}); my $have_mode; if (defined $mode) { $mode = ($mode | (($mode & 0444) >> 2)); $have_mode = 1; } else { $mode = 0755; } # Make sure we actually have directories we have to create. return 1 unless ($path =~ m%/%); $path =~ s%/+[^/]*$%%; $path =~ s%//+%/%g; return 1 if (-d $path); # Now, do some fun magic to check each of the directories in the path in # succession and make sure they all exist. We'll assume / exists, but # make sure we handle relative paths correctly. If someone is running us # with --just-print, we only report each directory we have to create once # to avoid lots of spew. my $directory = ($path =~ m%^/%) ? '/' : ''; $path =~ s%^/%%; for my $element (split ('/', $path)) { $directory .= $element; debug " checking $directory"; unless (-d $directory) { report ('create', $directory . '/') unless ($CONFIG{'just-print'} && $REPORTED{$directory}); $REPORTED{$directory} = 1; next if $CONFIG{'just-print'}; mkdir ($directory, $mode) or return; if (defined $owner || defined $group) { chown ($owner, $group, $directory); } chmod ($mode, $directory) if $have_mode; save_command ('rmdir', $directory); } } continue { $directory .= '/'; } 1; } # Stat a source file, reporting warnings on various error conditions and # returning a File::stat object otherwise. sub stat_source { my ($source, $follow) = @_; my $stats = $follow ? stat $source : lstat $source; if (!$stats) { warn "$0: can't stat source file $source: $!\n"; return; } elsif (!-f _ && ($follow || !-l _)) { warn "$0: $source is not a file\n"; return; } $stats; } # Stat a destination file, reporting warnings on various error conditions and # returning a File::stat object otherwise. sub stat_dest { my $destination = shift; my $stats = lstat $destination; if (-e _ && !$stats) { warn "$0: can't stat destination file $destination: $!\n"; return; } elsif (-e _ && !-f _ && !-l _) { warn "$0: $destination is not a regular file\n"; return; } defined $stats ? $stats : 'nonexistent'; } # Stat a target file, reporting warnings on various error conditions and # returning a File::stat object otherwise. sub stat_target { my $file = shift; my $stats = stat $file; if (-e _ && !$stats) { warn "$0: can't stat file $file: $!\n"; return; } $stats; } # Save a file as a backup (used when --backup is used instead of unlink). A # file named $file is saved as ".backup.$file.$time" where $time is the # current time. Return undef on failure, true on success. Takes a second # argument that, if true, says to use copy instead of rename to make the # backup. sub save_file { return 1 unless $CONFIG{backup}; debug "save: @_"; my ($file, $copy) = @_; my $stats = stat_dest $file; return 1 unless ref $stats; # Build our backup file name, keeping in mind $file is a full path. my $backup = $file . '.' . time . '.' . int rand 1000; $backup =~ s%/([^/]+)$%/.b.$1%; # Create the backup by renaming, so we don't have to deal with differences # between symlinks and regular files, etc. This is safe since we're doing # this in the same directory. If the backup file already exists, we don't # replace it. if (-l $backup || -e _) { warn "$0: backup file $backup already exists\n"; return; } unless ($copy ? copy ($file, $backup) : rename ($file, $backup)) { warn "$0: unable to backup $file: $!\n"; return; } # In case we're closing a security hole, make sure the old file is # inaccessible. Also set its timestamps to match the original if we # copied. if (!-l $backup) { chmod (0, $backup); utime ($stats->atime, $stats->mtime, $backup) if $copy; } # Note that we only need to chown if we backed up by copying; otherwise, # we backed up by renaming which preserves ownership. We have to delete # the file we're restoring first, since rename won't overwrite. if (!-l _) { save_chmod ($stats->mode, $file); save_chown ($stats->uid, $stats->gid, $file) if $copy; } save_command ('rename', $backup, $file); save_command ('delete', $file); 1; } ############################################################################## # Bundle commands ############################################################################## # Add lines to an existing file. We scan the entire file first to see if it # already contains any of the lines that we're going to add and don't add # those lines that already occur elsewhere in the file (unless force is set, # of course). When force is set, addline is identical to append. sub do_addline { debug "do_addline: @_"; my $file = shift; my @lines = map { $_ . "\n" } @_; # We need to open the file either way, to check to see if we need to # append or to do the append. We don't need write access to just check, # but it's easier to only do one open. The check will therefore fail # unless you have permissions to do the addline. if (sysopen (FILE, $file, O_RDWR | O_APPEND)) { unless ($CONFIG{force}) { my $line; sysseek (FILE, 0, 0); while (defined ($line = )) { if (@lines == 1) { undef @lines if ($line eq $lines[0]); } else { @lines = grep { $_ ne $line } @lines; } last unless @lines; } unless (@lines) { okay $file; return; } } report ('add lines to', $file); return if $CONFIG{'just-print'}; save_file ($file, 1) or return; my $text = join ('', @lines); if (syswrite (FILE, $text, length $text)) { command (undef, $file); } else { warn "$0: can't append to $file: $!\n"; } close FILE; } else { warn "$0: can't open $file: $!\n"; } } # Append strings to an existing file. We read the end of the file to see if # it contains the string we're going to append and consider the file okay if # it does (unless force is set, of course). This means that no more than one # append directive for any given file should be in one bundle file if the # bundle file should do nothing when already applied. sub do_append { debug "do_append: @_"; my $file = shift; my $text = join ("\n", @_, ''); # We need to open the file either way, to check to see if we need to # append or to do the append. We don't need write access to just check, # but it's easier to only do one open. The check will therefore fail # unless you have permissions to do the append. if (sysopen (FILE, $file, O_RDWR | O_APPEND)) { unless ($CONFIG{force}) { sysseek (FILE, -(length $text), 2); my $data; sysread (FILE, $data, length $text) or undef $data; if ($data eq $text) { okay $file; return; } } report ('append to', $file); return if $CONFIG{'just-print'}; save_file ($file, 1) or return; if (syswrite (FILE, $text, length $text)) { command (undef, $file); } else { warn "$0: can't append to $file: $!\n"; } close FILE; } else { warn "$0: can't open $file: $!\n"; } } # chmod a file. Takes the mode and the file as parameters. sub do_chmod { debug "do_chmod: @_"; my $mode = shift; my $file = shift; my $stats = stat_target $file or return; # Figure out the desired mode, allowing for +/- mode masks in $mode as # well as absolute modes. $mode =~ s/^([-+])//; my $sign = $1; $mode = oct $mode; if (defined $sign) { my $base = ($stats->mode & 07777); $mode = ($sign eq '-') ? ($base & ~$mode) : ($base | $mode); } # Check to see if we have anything to do, and if so, do the chmod. if ($CONFIG{force} || ($stats->mode & 07777) != $mode) { report ('chmod', $file); return if $CONFIG{'just-print'}; if (chmod ($mode, $file)) { save_chmod ($stats->mode, $file); command (undef, $file); } } else { okay $file; } } # chown a file. Takes the owner, group, and file as parameters. sub do_chown { debug "do_chown: @_"; my $owner = name2uid shift; my $group = name2gid shift; my $file = shift; my $stats = stat_target $file or return; # We don't want to incorrectly decide we need to chmod when $owner or # $group is undefined or -1. Our overridden chown call turns undef back # into -1 for the system call. $owner = undef if $owner == -1; $group = undef if $group == -1; my $owner_ok = (!defined $owner || $stats->uid == $owner); my $group_ok = (!defined $group || $stats->gid == $group); if ($CONFIG{force} || !$owner_ok || !$group_ok) { report ('chown', $file); return if $CONFIG{'just-print'}; if (chown ($owner, $group, $file)) { save_chown ($stats->uid, $stats->gid, $file); command (undef, $file); } } else { okay $file; } } # Delete a file. sub do_delete { debug "do_delete: @_"; my ($file) = @_; if (-l $file || -e _) { report ('delete', $file); return if $CONFIG{'just-print'}; if ($CONFIG{backup} ? save_file $file : unlink $file) { command (undef, $file); } else { warn "$0: can't unlink $file: $!\n" unless $CONFIG{backup}; } } else { okay $file; } } # Create a directory. The default mode (if none is specified via other means) # is 0755, modified by umask. If the directory already exists and we have a # mode or ownership set or are changing the time on things, make sure it # matches. sub do_dir { debug "do_dir: @_"; my ($dir) = @_; my $update; if (!-d $dir) { $update = 2; mkdir_chain $dir . '/' or return; return if $CONFIG{'just-print'}; if (defined $CONFIG{uid} || defined $CONFIG{gid}) { chown ($CONFIG{uid}, $CONFIG{gid}, $dir); } if (defined $CONFIG{mode}) { chmod ($CONFIG{mode}, $dir) } if (defined $CONFIG{atime} || defined $CONFIG{mtime}) { utime ($CONFIG{atime}, $CONFIG{mtime}, $dir); } } else { my $stats = stat_target $dir; my $owner = first_defined ($CONFIG{uid}, $stats->uid); my $group = first_defined ($CONFIG{gid}, $stats->gid); my $mode = first_defined ($CONFIG{mode}, $stats->mode & 07777); my $atime = first_defined ($CONFIG{atime}, $stats->atime); my $mtime = first_defined ($CONFIG{mtime}, $stats->mtime); if (($owner != -1 && $owner != $stats->uid) || ($group != -1 && $group != $stats->gid)) { $update = 1; report ('chown', $dir . '/'); if (!$CONFIG{'just-print'} && chown ($owner, $group, $dir)) { save_chown ($stats->uid, $stats->gid, $dir); $update = 2; } } if ($mode != ($stats->mode & 07777)) { report ('chmod', $dir . '/'); $update = 1; if (!$CONFIG{'just-print'} && chmod ($mode, $dir)) { save_chmod ($stats->mode, $dir); $update = 2; } } if ($atime != $stats->atime || $mtime != $stats->mtime) { report ('update', $dir . '/') unless $update; $update = 1; if (!$CONFIG{'just-print'} && utime ($atime, $mtime, $dir)) { $update = 2; } } # If we didn't change anything, the directory was okay. okay $dir unless $update; } # Run our command, if any, if we changed anything. command (undef, $dir) if ($update == 2); } # Print something to the screen if we're not supposed to be quiet. sub do_echo { debug "do_echo: @_"; print "@_\n" unless $CONFIG{quiet}; save_command ('# echoed', @_); } # Sync a file with another file. Takes the source file and the destination # file and then any additional arguments as parameters. sub do_file { debug "do_file: @_"; my ($source, $dest) = @_; my $s_stats = stat_source ($source, 1) or return; my $d_stats = stat_dest $dest or return; # Figure out the owner, group, and mode to use for the created file. my $owner = first_defined ($CONFIG{uid}, $s_stats->uid); my $group = first_defined ($CONFIG{gid}, $s_stats->gid); my $mode = first_defined ($CONFIG{mode}, ($s_stats->mode & 07777)); my $atime = first_defined ($CONFIG{atime}, $s_stats->atime); my $mtime = first_defined ($CONFIG{mtime}, $s_stats->mtime); # Now, let's see if we have any actual work we have to do. Currently, we # just check to see if either the times or the sizes are different and act # accordingly; at some point in the future, we may want to do a real diff # or the moral equivalent. my $update; if (!-e _ || $CONFIG{force} || $mtime != $d_stats->mtime || $s_stats->size != $d_stats->size) { # First, check to see if the destination file is newer, in which case # we don't do anything if --younger was specified. if (-e _ && $CONFIG{younger} && $mtime < $d_stats->mtime) { okay ($dest, $source); return; } # Make sure we have the leading directories for the destination. my $exists = -e _; mkdir_chain ($dest, $owner, $group, $mode) if (!$exists); # Print out output and bail if we're not changing anything. report ($exists ? 'update' : 'install', $dest, $source); return if $CONFIG{'just-print'}; # Now copy in the new file, giving it a temporary name so that we can # set permissions. my $destname = "$dest.bundle.$$"; unless (copy ($source, $destname)) { warn "$0: copy to $destname failed\n"; unlink $destname or warn "$0: can't unlink $destname: $!\n"; return; } # Set the owner, group, times, and permissions on the new copy to # match the old ones or the specified ones, whichever. utime ($atime, $mtime, $destname); chown ($owner, $group, $destname); chmod ($mode, $destname); # Finally, move the old file out and the new file in. unless (save_file ($dest) && rename ($destname, $dest)) { warn "$0: rename to $dest failed: $!\n"; unlink $destname or warn "$0: can't unlink $destname: $!\n"; return; } save_command ('delete', $dest) unless $exists; $update = 2; } else { # Make sure the permissions and ownership are the same. if (($owner != -1 && $owner != $d_stats->uid) || ($group != -1 && $group != $d_stats->gid)) { $update = 1; report ('chown', $dest, $source); if (!$CONFIG{'just-print'} && chown ($owner, $group, $dest)) { save_chown ($d_stats->uid, $d_stats->gid, $dest); $update = 2; } } if ($mode != ($d_stats->mode & 07777)) { report ('chmod', $dest, $source) unless $update; $update = 1; if (!$CONFIG{'just-print'} && chmod ($mode, $dest)) { save_chmod ($d_stats->mode, $dest); $update = 2; } } okay ($dest, $source) unless $update; } # If we changed something, run the post-command. command ($source, $dest) if ($update == 2); } # Ensure that a file exists. If it does, do nothing; otherwise, create an # empty file with the appropriate owner and permissions (permissions of 0644 # if none are otherwise specified). sub do_filexists { debug "do_filexists: @_"; my ($file) = @_; if (-l $file || -e _) { if (-f _) { okay $file; } else { warn "$0: $file is not a file\n"; } } else { my $mode = first_defined ($CONFIG{mode}, 0644); mkdir_chain $file; report ('create', $file); return if $CONFIG{'just-print'}; if (sysopen (FILE, $file, O_CREAT | O_EXCL | O_WRONLY, $mode)) { close FILE; chown ($CONFIG{uid}, $CONFIG{gid}, $file); chmod ($mode, $file); if (defined $CONFIG{atime} || defined $CONFIG{mtime}) { utime ($CONFIG{atime}, $CONFIG{mtime}, $file); } save_command ('delete', $file); command (undef, $file); } else { warn "$0: can't create $file: $!\n"; } } } # Runs a file, line by line, through the given Perl code as a filter, # basically as if perl -i -pe 'BEGIN { init } code' were run on the file. The # initialization code is the first argument, the filter code the second # argument. Note that the filter is done *in memory* because we want to see # if we actually changed anything before writing anything into the file system # (and we want to see if we're going to change anything even when running # under just-print). This means that filter should not be used on large files # as you will run bundle out of memory. sub do_filter { debug "do_filter: @_"; my ($file, $init, $code) = @_; # Wrap the code in an anonymous sub for ease of use, make sure it # compiles, and run the initialization code. If anything fails, it's a # fatal syntax error. my $sub = eval "{ $init; sub { $code } }"; if ($@) { die "$0: invalid filter code\n$@\n" } # Now, open our target file and read it in a line at a time, passing each # line to our filter and then pushing the results into @data. As we do # each line, we compare it against the original; only if we see a # difference have we actually changed the file. if (-l $file || !-f $file) { warn "$0: $file is not a regular file\n"; return; } my $stats = stat_target $file; unless (sysopen (FILE, $file, O_RDONLY)) { warn "$0: can't open $file: $!\n"; return; } # Wrap the actual read through the file in a block so that we can localize # $. without interfering with warning messages printed out elsewhere in # this sub. my (@data, $changed); { local ($_, $.); while () { my $original = $_; &$sub; $changed ||= ($original ne $_); push (@data, $_); } close FILE; } # If we made a change, replace the file with its filtered version. if ($changed || $CONFIG{force}) { report ('filter', $file); return if $CONFIG{'just-print'}; unless ($CONFIG{backup} ? save_file $file : unlink $file) { warn "$0: can't remove $file: $!\n" unless $CONFIG{backup}; return; } my $mode = $stats->mode & 07777; if (sysopen (FILE, $file, O_CREAT | O_EXCL | O_WRONLY, $mode)) { chown ($stats->uid, $stats->gid, $file); chmod ($mode, $file); my $success; WRITE: { for (@data) { my $status = syswrite (FILE, $_, length $_); last WRITE unless defined $status; } close FILE or last WRITE; $success = 1; } if ($success) { command (undef, $file); } else { close FILE; warn "$0: writing to $file failed: $!\n"; } } else { warn "$0: can't create $file: $!\n"; } } else { okay $file; } } # Rename a file to something else. This will fail if the destination already # exists (use delete to get rid of it first if necessary). We assume that # we've already done this if the destination exists and the source does not. sub do_rename { debug "do_rename: @_"; my ($source, $destination) = @_; # Check to see if the file has already been renamed. Make sure we don't # follow the symlink. if (-l $destination || -e _) { if (!-l $source && !-e _) { okay $destination; } else { warn "$0: can't rename to $destination, already exists\n"; } } else { if (!-l $source && !-e _) { warn "$0: can't rename $source, file doesn't exist\n"; } else { report ('rename', $source); return if $CONFIG{'just-print'}; if (move ($source, $destination)) { save_command ('rename', $destination, $source); command ($source, $destination); } else { warn "$0: rename of $source failed: $!\n"; } } } } # Delete a directory sub do_rmdir { debug "do_rmdir: @_"; my ($directory) = @_; my $stats = lstat $directory; if (defined $stats && -d _) { report ('delete', $directory . '/'); return if $CONFIG{'just-print'}; if (rmdir $directory) { if ($CONFIG{backup}) { my $owner = sprintf ('owner=%d', $stats->uid); my $group = sprintf ('group=%d', $stats->gid); my $mode = sprintf ('mode=%o', $stats->mode & 07777); my $atime = sprintf ('atime=%d', $stats->atime); my $mtime = sprintf ('mtime=%d', $stats->mtime); save_command ('dir', $directory, $owner, $group, $mode, $atime, $mtime); } command (undef, $directory); } else { warn "$0: can't rmdir $directory: $!\n"; } } elsif (defined $stats) { warn "$0: $directory is not a directory\n"; } else { okay $directory; } } # This creates a symbolic link with the given value at destination. It takes # an optional additional parameter giving the source file if any in order to # get the messages right. Note that no effort is made to change the # permissions or ownership on a symbolic link. sub do_symlink { my ($value, $dest, $source) = @_; debug "do_symlink: @_"; # Make sure the destination is valid. if (!-l $dest && -e _ && !-f _) { warn "$0: $dest is not a regular file\n"; return; } # Create the symlink, unlinking the destination if it exists and it # differs. if (-l _ && !$CONFIG{force} && readlink $dest eq $value) { okay ($dest, $source); } else { my $exists = -e _; mkdir_chain $dest; report ($exists ? 'update link' : 'install link', $dest, $source); return if $CONFIG{'just-print'}; if ($exists) { unless ($CONFIG{backup} ? save_file $dest : unlink $dest) { warn "$0: can't unlink $dest: $!\n"; return; } } symlink ($value, $dest); save_command ('delete', $dest); command (undef, $dest); } } # Sync one symlink with another (in other words, use the value of the source # symlink to create the destination link). sub do_linkval { debug "do_linkval: @_"; my ($source, $destination) = @_; my $value = readlink $source; if ($value) { do_symlink ($value, $destination, $source); } else { warn "$0: can't read source link $source\n"; } } # Run a given command. This is unconditional; there's nothing we have to # check to see whether or not we can do it. sub do_system { debug "do_system: @_"; report ("system: @_"); return if $CONFIG{'just-print'}; system @_ and warn "$0: @_ returned exit status $?\n"; save_command ('# ran system', @_); } ############################################################################## # Main routine ############################################################################## # Make sure error messages come at the right time. $| = 1; # Read in the command line and default to reading bundle commands from STDIN # if no bundle file was given. We have to scan @ARGV for a single dash first, # since Getopt::Long can't handle it. my $bundle; for (my $i = 0; $i < @ARGV; $i++) { if ($ARGV[$i] eq '-') { $bundle = '-'; splice (@ARGV, $i, 1); last; } } read_options; $bundle = @ARGV ? shift : '-' unless $bundle; # Change directories if requested. if ($CONFIG{cwd}) { chdir $CONFIG{cwd} or die "$0: can't change directory to $CONFIG{cwd}: $!\n"; } # Find and open the bundle file. Make sure we correctly handle a bundle file # name of -, representing STDIN. if ($bundle eq '-') { $FILE = '-'; open (BUNDLE, '<&STDIN') or die "$0: can't dup stdin: $!\n"; } else { $FILE = find_bundle ($bundle) or die "$0: can't find bundle $bundle\n"; open (BUNDLE, $FILE) or die "$0: can't open $FILE: $!\n"; } # Now loop through the bundle, ignoring initial and trailing whitespace and # lines beginning with a #. Join together lines that end in backslashes to # allow continuation. while () { next if (/^\s*\#/ or /^\s+$/); s/^\s+//; s/\s+$//; while (s/\\$//) { $_ .= "\n" . ; s/\s+$// } # Figure out what we're supposed to do and do it. We call a separate # function to parse out the line. my @command = parse_line ($_); # Decide what to do based on the initial portion of the command. When # running commands, we pass them through run, which is told how many # arguments they take and handles one-line variable settings at the end of # the command. An undef means that the command takes any number of # arguments and doesn't allow variable setting. my $command = shift @command; if ($command eq 'addline') { run (\&do_addline, undef, @command) } elsif ($command eq 'append') { run (\&do_append, undef, @command) } elsif ($command eq 'chmod') { run (\&do_chmod, 2, @command) } elsif ($command eq 'chown') { run (\&do_chown, 3, @command) } elsif ($command eq 'delete') { run (\&do_delete, 1, @command) } elsif ($command eq 'dir') { run (\&do_dir, 1, @command) } elsif ($command eq 'echo') { run (\&do_echo, undef, @command) } elsif ($command eq 'file') { run (\&do_file, 2, @command) } elsif ($command eq 'filexists') { run (\&do_filexists, 1, @command) } elsif ($command eq 'filter') { run (\&do_filter, 3, @command) } elsif ($command eq 'link') { run (\&do_symlink, 2, @command) } elsif ($command eq 'linkval') { run (\&do_linkval, 2, @command) } elsif ($command eq 'rename') { run (\&do_rename, 2, @command) } elsif ($command eq 'rmdir') { run (\&do_rmdir, 1, @command) } elsif ($command eq 'symlink') { run (\&do_symlink, 2, @command) } elsif ($command eq 'system') { run (\&do_system, undef, @command) } elsif ($command =~ /^(\w+)=(.*)$/) { set ($1 => $2) } else { die "$0:$bundle:$.: unknown bundle command $command\n" } } # All done. Close the bundle file and exit. close BUNDLE; __END__ ############################################################################## # Documentation ############################################################################## =head1 NAME bundle - Maintains a "bundle" of files =head1 SYNOPSIS bundle [B<-cdfhnopqsuyv>] [B<-D>I=I] [I[.b]] =head1 DESCRIPTION B is designed for two major purposes. It can be used to track a bundle of files and synchronize them with a master repository whenever anything changes, and it can be used to make incremental changes in such a way as to maintain change history and be able to apply all of the changes at once. B functions on bundle files, which are files of bundle commands, one per line. The most frequently used command specifies a source file and a destination file and tells bundle to update the destination file to be the same as the source file if they're different, but there are a variety of other commands for maintaining symbolic links, renaming, deleting, chowning, or chmoding files, running system commands, and other such things. This flexibility allows B to be used as an installation tool. All that's needed is a bundle file that lists source files and where they should be installed, and if anything changes in the master distribution, B can just be run against the same file again to pull in any files that have changed. It also lets B be used as an incremental change system, since the bundle file can list precisely what should be changed on a system, including references to the files that are needed as part of the change, and then all the incremental changes can be concatenated together to create a bundle file that will apply all changes to date. If B isn't given a bundle file on the command line, or if the file given is "-", B will read and execute bundle commands from stdin. =head1 OPTIONS B takes the following command-line options. B<--force> and B<--younger> can also be set in bundle files themselves (see the documentation of variables below below). Settings in the bundle file itself for those two options override command-line flags. =over 4 =item B<-h>, B<--help> Print out this documentation (which is done simply by feeding the script to C. =item B<-v>, B<--version> Print out the version of B and exit. =item B<-b>, B<--backup> Save backup information. Any files that are replaced, rather than being deleted, will be renamed to F<.b.FILE.TIME.RANDOM> where FILE is the original file name, TIME is the current time, and RANDOM is a random number between 0 and 1000. In addition, full details on how to reverse the change (in the form of bundle commands) will be printed out prefixed by S<" undo: "> as the bundle commands are executed. Normally, each undo command is on a single line, but if the undo information line ends in a \, the next line is also part of the undo information and special care should be taken to include it in any backout bundle. The backup bundle is generated in reverse order. To convert the output of C into a backup bundle, pipe it through the following commands: grep '^ undo: ' | sed 's/^ undo: //' | tac This does not work if there are any lines ending in \; in that case, something more complex will be needed. Note that system commands (or commands run as a result of setting the system variable) are not reversible and will result in comments in the backout bundle stating what command was run. Note also that if this option is used, backup files will be saved in the same directory as the original file, thus making it impossible to delete a file in a directory and then the directory itself (since the directory won't be empty). =item B<-C> I, B<--cwd> I Change the current working directory to the specified directory before finding and the running the bundle. =item B<-c>, B<--changes> Show the changes between the current files and the files that will be installed. Only shows changes for files installed with the B command where the new file will overwrite an existing file. Changes are given as unified diffs (except where the files are binary), but if the diff is longer than 100 lines, just the length of the diff will be shown. Enabling this option automatically enables B<-n> as well. Using this option requires that the first B program found in your path support the B<-u> option. There is currently no way to change the preferred diff format. =item B<-D> I=I, B<--define> I=I Defines the variable I to be equal to I. This is exactly equivalent to a variable assignment inside the bundle file itself, with all the same special variables; see below for full details. =item B<-d>, B<--debug> Enable debugging. This causes B to print out quite a few additional messages about what it's doing and what internal functions it's calling, useful for debugging problems in either a bundle file or in bundle itself. =item B<-f>, B<--force> Force all target files to be updated, even if they appear to be the same as the source files. This can also be set in the bundle file itself, and the setting in the bundle file overrides the command line. =item B<-n>, B<--just-print>, B<--dry-run> Do all of the checks that would normally be done, but rather than taking any actual actions, just print out what would have been done. Think C. This should be used to check the actions of a bundle file before it's used for the first time. =item B<-q>, B<--quiet> Don't print the normal report of what's being done. Only errors will be printed. This flag also suppresses the output of B commands in the bundle file. =item B<-s>, B<--source> Report the source location of a file when it is installed. By default, only the destination location is printed. =item B<-u>, B<--up-to-date> Report those actions which were unnecessary as well as those which were done (in other words, report actions which weren't performed because the targets were already up to date). =item B<-y>, B<--younger> By default, files will be installed if the timestamp of the source differs from the timestamp of the target. With this option, a file will only be installed if the source is newer than the target. Combining this option with B<--force> makes no sense. This can also be set in the bundle file itself, and the setting in the bundle file overrides the command line. =back =head1 BUNDLE FILES A bundle file is just a sequence of commands or variable settings, one per line, optionally interspersed with comments. Any line beginning with C<#> is taken to be a comment, and lines can be continued on the next line by putting C<\> at the end of a line. The trailing backslash will be stripped, but it's possible to put a newline inside a string by having the line continuation occur inside a quoted string. The individual arguments to commands are whitespace-separated; if it's necessary to give an argument that contains whitespace, the argument can be quoted. Both single and double quotes are supported; double-quoted strings undergo variable interpolation, while single-quoted strings do not. Inside double quotes, C<\> will escape any character, including quotes. Inside single quotes, C<\> will escape C<\> or C<'> but not any other character; C<\> followed by any other character in single quotes will be taken to be a literal backslash followed by that character. For more information on variable interpolation, see the section on variables below. The following commands are recognized: =over 4 =item addline FILE LINE [ LINE ... ] Adds each LINE to the end of FILE if and only if that line doesn't already occur somewhere in FILE. If B<--force> is set, FILE is not checked first and B acts identically to B. Otherwise, FILE is scanned a line at a time, and if any line in the list of lines to add to the file is found already in the file, it's removed from that list. Then the remaining lines are appended in order to the end of FILE. Because the entire file is checked, one can have multiple B commands affecting the same file and still run the bundle file repeatedly, unlike B. Note that since it takes a variable number of lines as arguments, B does not support setting variables on the same line as the command. For information on how to set B or B for just an B line, see the section on variables below. =item append FILE LINE [ LINE ... ] Appends each LINE to the end of FILE, separated by newlines. Unless B<--force> is set, FILE is checked first and if it ends in precisely the text that would be appended to it, it is considered to be up to date and no action is taken. The practical implication of this is that one should only have one B command per affected file in a bundle file if one wishes to be able to run the bundle file repeatedly without having more text appended each time; if that isn't what you want, B may be better. On the other hand, B is faster than B, particularly for large files. (If lines should be appended every time the bundle file is run, the B variable should be set for just the B line.) Note that since it takes a variable number of lines as arguments, B does not support setting variables on the same line as the command. For information on how to set B or B for just an B line, see the section on variables below. =item chmod MODE FILE Normally, given a MODE, changes the permissions on FILE to be MODE (where MODE is assumed to be in octal). If MODE begins with +, it is taken to be a mask, and the permissions on FILE are changed to be the same as they currently are but with all the bits in MODE turned on. If MODE begins with -, the permissions on FILE are changed so that all the bits in MODE are off. For example, to turn on the setuid bit of F and turn off the group and world read bits, leaving the rest of the permissions unchanged, use the following two chmod commands: chmod +4000 file chmod -0044 file Note that leading zeroes on MODE are allowed but not required; it's always assumed to be in octal. =item chown USER GROUP FILE Changes the ownership of FILE to user USER and group GROUP. The user and group can be either numeric or words (in which case, they're translated to numbers by using C and C). Note that either USER or GROUP may be -1, indicating no change should be made to that portion of the file ownership. For example: chown root -1 file will change the ownership of F to be root, but will leave the group ownership unchanged. =item delete FILE Deletes FILE. (This command won't work on directories; to remove a directory, use B instead.) =item dir DIRECTORY Creates the directory DIRECTORY (and any missing directories in the full path, recursively if necessary, similar to the function of C). The default permissions (if B isn't set) are 0755 modified by umask. If the directory already exists, and if any of B, B, B, B, or B are set and differ from the stats of the existing directory, it is updated to match the desired values. Note that if any setting of the B variable is in effect, it is used verbatim by the B command. If you've set B to something appropriate for regular files, this may result in a directory without execute permission, which is generally not what you want. One alternative is to always use an explicit setting of B on the same line as the B command; for details on how to do that, see below. Another alternative is to not use B commands and just let the directories be created automatically when something is put in them with a B command or another similar command, since then the created directories will have execute permission granted corresponding to the read permission granted in the mode of the file being created. Note also that the setting of B affects the final directory in the chain, but any created directories above that use the same magic determination of mode as ones created by B do. This is arguably a bug. =item echo TEXT [ TEXT ... ] If B<--quiet> was not specified, prints TEXT to stdout. =item file SOURCE TARGET Installs the file SOURCE as TARGET. In other words, if TARGET doesn't exist, or if TARGET exists but has a different timestamp or size than SOURCE, SOURCE is copied to TARGET (deleting TARGET if necessary). Any directories that are part of the path TARGET which don't already exist are created in the process. The ownership, permissions, atime, and mtime of TARGET will be set to be the same as SOURCE unless overridden by variable settings. =item filexists FILE Ensures that FILE exists. If it is present and is a regular file, it is considered up to date (permissions and ownership are not checked). If it doesn't exist, a zero-length file named FILE is created. The default permissions (if B isn't set) will be 0644 modified by umask. If it exists and isn't a regular file, an error message will be printed. =item filter FILE INIT FILTER Sets up a lexical block, executes INIT within that block, and then executes FILTER on each line of FILE, overwriting FILE with the results, in the same lexical block that INIT ran in. This is mostly (but not quite completely) equivalent to: perl -i -pe 'BEGIN { INIT } FILTER' FILE The mode and permissions of FILE are preserved. INIT and FILTER can be any valid Perl code; inside FILTER, C<$_> will contain the current line of FILE and modifying C<$_> will modify the current line of FILE. C and C blocks are unlikely to do what you expect. All code will be executed in the context of the running B process, so it's possible to severely confuse B or worse using this directive. Be cautious about how much you do, and declare any variables you use in the INIT section with C. Note that INIT can be empty if you have no need of persistent variables. The following fairly simple example replaces all occurances of "example.com" with "example.org" in /etc/hosts: filter /etc/hosts '' 's/example\.com/example\.org/' Here's a more complicated example that inserts the line "ssh\t\t22/tcp" after any line beginning with "ftp" and whitespace in /etc/services, if and only if the next line doesn't already begin with "ssh" and whitespace: filter /etc/services 'my $saw' '\ if ($saw) { \ $_ = "ssh\t\t22/tcp\n$_" unless /^ssh\s/; \ $saw = 0; \ } elsif (/^ftp\s/) { \ $saw = 1; \ } else { \ $saw = 0; \ } ' Observe that a bundle command is still just a single line, so if it's continued on multiple lines each line except the last has to end in a backslash. Also notice the quoting; because the code fragment is in single quotes, bundle doesn't try to do variable interpolation (which would be a mess) and backslashes inside single quotes are only special if followed by another backslash or by a single quote. So strings like C<\n> can be used as is in Perl code inside single quotes. Another thing to notice about this example is that we go to some lengths to ensure that we don't make any changes unless necessary. This lets us run a bundle file containing the above filter repeatedly without ill effect. The filtering is done in memory; this directive should not be used to modify large files. =item link VALUE TARGET A symbolic link named TARGET is created, with value VALUE. If TARGET already exists, it's deleted as necessary. Any directories that are part of the path TARGET which don't already exist are created in the process. Note that no effort is made to change the ownership or permissions on symbolic links; they get whatever defaults are assigned by the system. =item linkval SOURCE TARGET Copies the link SOURCE to TARGET. In other words, a symbolic link is created named TARGET which contains as its value the same value that the link SOURCE has. In general, this isn't as useful as the B command (see below) where the value can be specified directly. If TARGET already exists, it's deleted. Any directories that are part of the path TARGET which don't already exist are created in the process. Note that no effort is made to change the ownership or permissions on symbolic links; they get whatever defaults are assigned by the system. =item rename OLD NEW The file named OLD, if it exists, is renamed to NEW. (This is done as a copy and unlink if OLD and NEW are on different file systems.) If OLD does not exist and NEW does, B assumes this command is up to date and takes no action; other cases (including the case where NEW already exists) are considered errors. =item rmdir DIRECTORY Removes DIRECTORY. This only works if DIRECTORY is empty; there is no way in bundle to do the equivalent of C without using B. =item system COMMAND [ ARGUMENT ... ] Runs the command COMMAND, passing it the specified arguments. Note that this doesn't have any dependencies and therefore B has no way of knowing whether it has already been done and will run this command every time the bundle file is run. If COMMAND contains shell metacharacters, it must be specified as one quoted string rather than as a command with arguments; if given as a command with arguments, the command will be run directly without going through the shell, so there is no need to protect shell metacharacters in the arguments. (It's still necessary to protect bundle metacharacters, of course.) =back Note that for any bundle command that creates files, directories, or symbolic links, such as B, B, B, B, and the like, if the directory in which the target file resides does not exist, bundle will create it. Any needed directories above that directory are also created. Ownership and permissions are inherited from the settings in force at the time of the command, and the execute bit on each created directory is set if the read bit on the file would be set. B also supports variables. A variable can be set with the syntax: VARIABLE=VALUE on a line by itself, where VARIABLE consists of alphanumerics or underscores and VALUE is any value (it will need to be put in double quotes if it contains whitespace, and it follows the same quoting rules as commands). Note that there cannot be any spaces before or after the equal sign. After a variable has been set, it can be interpolated into any command. For example: SOURCE=/usr/pubsw/etc DEST=/etc/leland owner=root file $SOURCE/krb.conf $DEST/krb.conf will copy /usr/pubsw/etc/krb.conf to /etc/leland/krb.conf. Variables will be interpolated within double-quoted strings; a literal dollar sign can be written as C<\$> or protected with single quotes. Both the C<$VARIABLE> and C<${VARIABLE}> syntaxes are supported. All variables consisting solely of all lowercase letters are special; most are reserved by bundle. These variables cannot be interpolated into commands; instead, they affect the operation of bundle in other ways. Special variables (and only those) can be set at the end of a normal bundle command as well as by the syntax described above. For example, the above could also be written as: SOURCE=/usr/pubsw/etc DEST=/etc/leland file $SOURCE/krb.conf $DEST/krb.conf owner=root and would perform the same action. Assignments on a line by themselves are permanent and will affect all bundle commands after them in the bundle file. Assignments on the same line as a command, as in the previous example, are in effect B. To undefine a variable, just assign the empty string to it. For example: SOURCE= The following special variables can be set in bundle files: =over 4 =item atime=TIME Sets the atime (access timestamp) of files or directories created with the B, B, or B commands to TIME (in the case of B, overriding the timestamp of the source file). TIME should be in Unix time format (seconds since epoch). =item force=1, force=0 Turns B<--force> on (or off). This overrides the command line flag and is mostly useful at the end of a specific bundle command which should always be performed regardless of whether the target appears to be up to date. =item group=GROUP Sets the group ownership of created files to GROUP. By default, created files are owned by the same group as the source file. GROUP may be either by GID or by name. It's recommended that, for files that should be owned by group 0, the group be specified by number rather than by name since the name of that group differs across platforms. GROUP may be set to -1 to indicate that no changes in group ownership should be made. =item mode=MODE Sets the permissions of created files to MODE (assumed to be in octal). By default, created files are given the same mode as the source file. =item mtime=TIME Sets the mtime (modification timestamp) of files or directories created with the B, B, or B commands to TIME (in the case of B, overriding the timestamp of the source file). TIME should be in Unix time format (seconds since epoch). Note that if this variable is set, the target file of a B command will be considered to be out of date and require an update if its mtime isn't equal to TIME (rather than comparing it to the timestamp on the source file). =item owner=OWNER Sets the owner of created files to OWNER. By default, created files are owned by the same group as the source file. OWNER may be either by UID or by name. OWNER may be set to -1 to indicate that no change in ownership should be made. =item system=COMMAND Runs COMMAND for every successful bundle command. (For obvious reasons, this is most useful at the end of a specific bundle command rather than as a standalone variable setting that would affect all subsequent commands, although the standalone setting is necessary to run a system command based on the results of an B command.) If COMMAND contains arguments, or otherwise contains whitespace, it will need to be in double quotes to prevent bundle from interpreting the whitespace as separators. %S will be replaced with the source file %D with the target file of the associated command, if any. The command specified in the B variable is run only if the bundle command the variable is associated with was performed, so this is a way to get system commands with dependencies. =item younger=1, younger=0 Turns B<--younger> on (or off). This overrides the command line flag and is mostly useful at the end of a specific bundle command which should take effect only if the target is older than the source file. =back The B and B commands don't allow any variable settings on the same line and ignore all variable settings (except for interpolation). The B and B commands similarly don't allow variable settings on the same line but do honor the B and B variables. In order to set one of those variables for just an B or B command, it's necessary to use a sequence of lines like: force=1 addline /path/to/file "First line" "Second line" force=0 to force the addline or append but not the other commands in the bundle file. =head1 EXAMPLES The following sample bundle file installs a full set of Kerberos executables and configuration files. Notice that in no case is the ownership or mode of the original files trusted; instead, an explicit default ownership of root.0 is given and a default mode of 644 for configuration files and 755 for executable files is used. Note also the rule for installing ksu overrides the default mode for just that one bundle command. owner=root group=0 mode=644 file /usr/pubsw/etc/krb.conf /etc/leland/krb.conf link leland/krb.conf /etc/krb.conf file /usr/pubsw/etc/krb5.conf /etc/leland/krb5.conf link leland/krb5.conf /etc/krb5.conf file /usr/pubsw/etc/krb.realms /etc/leland/krb.realms link leland/krb.realms /etc/krb.realms file /usr/pubsw/etc/hesiod.conf /etc/leland/hesiod.conf link leland/hesiod.conf /etc/hesiod.conf file /usr/pubsw/lib/zephyr/zephyr.vars /etc/leland/zephyr.vars mode=755 file /usr/pubsw/sbin/login.krb /etc/leland/login.krb file /usr/pubsw/sbin/klogind /etc/leland/klogind file /usr/pubsw/sbin/kshd /etc/leland/kshd file /usr/pubsw/sbin/kftgtd /etc/leland/kftgtd file /usr/pubsw/bin/aklog /etc/leland/aklog # comment this out if you don't want ksu installed locally file /usr/pubsw/sbin/ksu.nosetuid /usr/bin/ksu mode=4111 file /usr/pubsw/sbin/telnetd /etc/leland/telnetd file /usr/pubsw/sbin/zhm /etc/leland/zhm file /usr/pubsw/sbin/sidentd /etc/leland/sidentd file /usr/pubsw/sbin/tcpd /etc/leland/tcpd =head1 ENVIRONMENT =over 4 =item BUNDLE_LIB A colon-separated list of directories to search through for bundle files. Note that . (the current directory) is B searched by default unless it is included in the search path. The default search path is set at the top of the bundle script. =back =head1 NOTES While B is very free-form about the syntax allowed in its files, in practice there are a few style guidelines that I've found useful for keeping the files clear, readable, and maintainable. Here's a short list. If you're using B to install a set of related files, consider writing your bundle file to use relative paths for the source location of those files. That way, you can take your bundle file and all of its associated files and move them around or distribute them as a package and no changes to the bundle file are needed; anyone running it simply has to change to that directory before doing so. If this doesn't fit your application, at least put the common source directory as a variable set at the top of the bundle file and have all of the commands in the file use that variable so that you only have to change one line. It's worth going to some effort to prevent things from going over 80 columns to keep them more readable. Remember that bundle allows continuation lines just by ending a line with a backslash, and remember that you can define variables and thereby abbreviate long paths. There are a lot of bundle commands, particularly the frequently used B command, that take two arguments. I generally line up the second arguments at column 34 (provided the first argument isn't too long); the whitespace makes things look more readable to me. Putting one-line B variable settings on the next line from the command, indented four spaces (and with a backslash on the previous line, of course), seems to make them stand out better. For example: file $FILES/aliases /etc/mail/aliases \ system="/usr/lib/sendmail -bi" Remember that bundle files allow blank lines and comments. Comments are good. =head1 BUGS The bundle generated by the B<--backup> flag in the case of a B directive that replaces an existing file is not idempotent, and in fact running the backout bundle twice will cause the file to be deleted completely. This is obviously bad and should be fixed; the only clear way of fixing it would appear to be to add a new directive like B that is willing to overwrite a destination file. The B directive honors mode verbatim for the last directory created, but any directories higher on the chain use the magic mode formed by ensuring that there is execute permission for every user who has read permission. This is arguably a bug. There is no way to set a variable to the empty string. =head1 WARNINGS The behavior of chown on symlinks is undefined; this is not the fault of B or Perl but the fault of the underlying system call. On some systems, chown will follow the link and change the ownership of the file it points to; on other systems, chown will change the ownership of the link. Having a symbolic link be the target of a chown command is therefore not recommended. B does not implement lchown. Those sensitive about security should note that while some effort has been taken to avoid possible security problems, there are a number of race conditions involving file creation and overwriting still remaining, particularly with the B and B commands. Running those commands with target files in world-writeable directories while B is running as root is not recommended. There is a possibility (roughly one in a thousand) that, when running B with the B<--backup> flag and making multiple changes to the same file in the course of a single bundle file, that B will fail to make a backup of intermediate versions of the file. B<--just-print> may also return errors or incorrect information for a bundle file that makes multiple changes to the same file. Setting B or B to -1 indicates that no changes should be made to the file ownership or group ownership, not to chown the file to the UID or GID one less than the maximum value (often C or C). To specify that UID or GID, use its name or its positive UID value. =head1 AUTHORS The original bundle program (based on synctree from the University of Michigan) was written by Roland Schemers . It has since been rewritten by Russ Allbery who currently maintains it. =head1 COPYRIGHT AND LICENSE Copyright 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2002, 2003, 2004, 2006, 2008 Board of Trustees, Leland Stanford Jr. University This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. =cut