#!/usr/local/bin/perl -w
#
# rcsedit -- edit a file using RCS control
#
# Copyright 1996, 1997, 2001, 2006 LavaNet, Inc.
# This program is distributed under the terms of the GNU
# General Public License, Version 2 (June 1991).
#
# http://www.lava.net/rcsedit/
# Comments, bugs, suggestions to: rcsedit@lava.net
#
# rcsedit uses rcs to check out a file, invoke an editor, and check the
# file back in when done. It assumes the file is already under RCS control
# and is editable by the user.
#
# history
#
# 1.00 96.07.16
# initial release.
# 1.1.0 97.10.03
# Now handles case where file has never been checked in
# 1.2 2001.01.28
# Preserve the owner and group on the working file, something
# RCS doesn't do by itself (jlc).
# 1.3 Preserve original username of person invoking rcsedit (useful
# if rcsedit is being run via sudo, etc). Records this username
# in RCS log. General style cleanup. (bkf)
use strict;
require 5.005_03;
use Cwd qw(getcwd);
use English qw(-no_match_vars);
use File::Basename qw(basename dirname);
use Getopt::Long qw(GetOptions);
# We'd use Fcntl qw(:mode) here, but they're not available in 5.005_03.
# This means this is slightly unportable.
use constant S_ISUID => 04000;
use constant S_ISGID => 02000;
use constant S_IWUSR => 0200;
use constant S_IWGRP => 0020;
use constant S_IWOTH => 0002;
# preliminary setup
#
$OUTPUT_AUTOFLUSH = 1; # unbuffer output
# paths - set appropriately
#
# These are left as relative paths so that the PATH variable is used,
# but set to (OS-dependent) absolute paths for better security.
#
use vars qw($LS $RCS_CO $RCS_CI $RCS_LOG $RCS_DIFF $DEFAULT_EDITOR);
$LS = 'ls';
$RCS_CO = 'co';
$RCS_CI = 'ci';
$RCS_LOG = 'rlog';
$RCS_DIFF = 'rcsdiff';
$DEFAULT_EDITOR = 'vi';
# TODO at least test for existence/executability of these files
# other definitions
#
# TODO allow setting of all options used for ci and co (such as -d and -M)
use vars qw($VERSION $RCS_DIR $RCS_TZ $LS_OPTS $PICO_KLUDGE);
$VERSION = 1.3;
$RCS_DIR = 'RCS'; # default
$RCS_TZ = '-zLT'; # local time
$LS_OPTS = '-la'; # long listing, include entries beginning w/ '.'
$PICO_KLUDGE = 1; # set to 1 to disable word wrap if pico is editor
use vars qw($prog);
$prog = basename $PROGRAM_NAME;
# TODO this doesn't seem to work as advertised for jlc, but I don't have
# access to an environment suitable to debug this. I'm afraid he'll have
# to figure it out. [bkf]
#
# TODO the original intent was to put a notation that rcsedit was called
# via sudo, but unfortunately this can't be stored in the author field we
# found out. the mystery, though, is that SUDO_USER says root on some
# systems and the username on others despite the setting of set_logname in
# the sudoers file. so the following still needs work.
#
# maybe just let rcs figure it out from the LOGNAME variable alone?
# rcs uses LOGNAME if set (unless it thinks it's unsecure for some
# reason, in which case it does other stuff). - jlc
#
if ($ENV{SUDO_USER})
{
$ENV{LOGNAME} = $ENV{SUDO_USER};
}
# usage info
#
use vars qw($USAGE);
$USAGE = <<"END_USAGE";
Usage: $prog [-help] [-version] [-debug] [file1 file2...]
\u$prog will use RCS to check out a file, invoke an editor, then check the
file back in when done. Multiple files may be specified. If no files are
specified, $prog will prompt for one. RCS co is performed with "-l" option.
RCS ci is performed with "-u" option.
Options:
-help Usage information.
-version The version of this software, what else?
-debug Enable debugging output.
Options may also be specified with single character abbreviations.
[-h] [-v] [-d]
END_USAGE
# process options
#
use vars qw($help $version $debug);
if (!GetOptions
(
'help' => \$help,
'version' => \$version,
'debug' => \$debug,
))
{
print $USAGE;
exit;
}
if ($help)
{
print $USAGE;
exit;
}
if ($version)
{
print "$prog: version $VERSION\n";
exit;
}
# set editor
#
# This prefers the better-named EDITOR over VISUAL. For comparison,
# several old Unix programs that call an editor work differently:
# crontab -e VISUAL
# less VISUAL
# chsh EDITOR
# edquota EDITOR
#
use vars qw($editor);
$editor = $ENV{'EDITOR'} || $ENV{'VISUAL'} || $DEFAULT_EDITOR;
if ($editor eq 'pico' && $PICO_KLUDGE)
{
$editor = 'pico -w';
}
if ($debug)
{
print "DEBUG \$editor: $editor\n";
}
#
# main
#
if (! @ARGV)
{
push @ARGV, prompt("file to edit: ");
}
FILE:
foreach my $file_arg (@ARGV)
{
my $file = basename $file_arg;
my $file_path = dirname $file_arg;
my $retval;
if (! -e $file_arg)
{
print "$file_arg doesn't exist! Skipping...\n";
next FILE;
}
if ($debug)
{
print "DEBUG \$file_arg: $file_arg\n";
print "DEBUG \$file_path: $file_path\n";
print "DEBUG \$file: $file\n";
}
my $cwd = getcwd;
if ($debug)
{
print "DEBUG \$cwd: $cwd\n";
print "DEBUG chdir (\"$file_path\")\n";
}
chdir ($file_path);
$retval = do_system($RCS_DIFF, $RCS_TZ, $file);
if ($retval == 1) # There were differences
{
die "\nThere are differences that haven't been checked in. Fix them and retry.\n\n";
}
if ($retval == 2) # Some kind of error (like RCS file not found)
{
my $response = prompt("\nI believe this file has never been checked in (but can't be sure)\nWould you like to check it in (y/N)? ");
if (substr(lc($response), 0, 1) eq "y")
{
$retval = do_system($RCS_CI, qw(-u -d -M), $RCS_TZ, $file);
if ($retval != 0)
{
die "Can't find RCS file!\n";
}
# Set the attributes on the RCS file to match those on the
# the working file (something RCS does not do).
#
my $RCS_file = `$RCS_LOG -R $file`;
if (($CHILD_ERROR >> 8) != 0)
{
die "Can't find RCS file!\n";
}
chomp $RCS_file;
my ($perm, $uid, $gid) = (stat $file)[2,4,5];
chown $uid, $gid, $RCS_file;
chmod $perm, $RCS_file;
}
else
{
die "Aborting...\n";
}
} # rcs error
do_rcs($RCS_CO, $RCS_TZ, qw(-l -M), $file)
or die "\nCheckout of file $file failed, cannot continue. Fix problem and retry.\n\n";
# Run the editor, but preserve file attributes before the editor is run.
# This is because both vi and pico under BSD/OS (and perhaps others) will
# remove any setuid or setgid after the file is saved.
{
my ($perm, $uid, $gid) = (stat $file)[2,4,5];
my $retval;
$retval = do_system($editor, $file);
if ($retval != 0)
{
die "editor returned non-zero exit code: $retval\n";
}
chown $uid, $gid, $file;
chmod $perm, $file;
}
do_rcs($RCS_CI, $RCS_TZ, qw(-u -d -M), $file)
or die "Couldn't check-in new revision.\n";
if ($debug)
{
print "DEBUG chdir (\"$cwd\")\n";
}
chdir $cwd; # restore working directory
} # FILE
#-----------------------------------------------------------------------------
sub prompt
{
my ($prompt_text) = @_;
print "$prompt_text";
my $response = <STDIN>;
chomp $response;
return $response;
}
#-----------------------------------------------------------------------------
sub issetuid
{
my ($perm) = @_;
return ($perm & S_ISUID);
}
#-----------------------------------------------------------------------------
sub issetgid
{
my ($perm) = @_;
return ($perm & S_ISGID);
}
#-----------------------------------------------------------------------------
sub do_rcs
{
my (@args) = @_;
my $file;
my ($new_perm, $new_rcs_perm, $preserved_uid, $preserved_gid, $RCS_file);
my $retval;
# The file is the last argument in the @args array.
$file = pop @args;
if ($debug)
{
print "DEBUG do_rcs: file = $file\n";
}
# Get the name of the RCS file.
#
$RCS_file = `$RCS_LOG -R $file`;
if (($CHILD_ERROR >> 8) != 0)
{
return 0;
}
chomp $RCS_file;
# Save the owner, group, and permissions from the working file so that we
# can attempt to restore them later.
#
my ($perm, $uid, $gid) = (stat $file )[2,4,5];
my ($rcs_perm, $rcs_uid, $rcs_gid) = (stat $RCS_file)[2,4,5];
# Check that the permissions on the RCS match the permissions on the
# working file (sans write bits), and that the user and group match. If
# not, have the user correct the situation manually.
#
# The reason for this is that when checking-out a file, RCS retains the
# permissions based solely on the RCS file. Since we want to preserve
# the permissions on the working file, we need to make sure the two match.
#
if ($rcs_perm != ($perm & ~(S_IWUSR | S_IWGRP | S_IWOTH)))
{
print "\
There is some mismatch in permissions, owner, or group between the
RCS file and the working file. Fix that first, wipe up, and come
on back.\n\n";
do_system($LS, $LS_OPTS, $file, $RCS_file);
print "\n";
return 0;
}
# Do the actual RCS command.
#
if ($debug)
{
print "DEBUG do_rcs(): before RCS command:\n";
do_system($LS, $LS_OPTS, $file, $RCS_file);
}
$retval = do_system(@args, $file);
if ($retval != 0)
{
if ($debug)
{
print "DEBUG do_rcs(): error executing RCS command\n";
}
return 0;
}
if ($debug)
{
print "DEBUG do_rcs(): after RCS command:\n";
do_system($LS, $LS_OPTS, $file, $RCS_file);
}
# Restore original user and group of working file and RCS file.
#
# NOTE: On some systems (mostly POSIX), doing a chown clears the setuid and
# setgid bits even if root, so we need to save the original permissions
# before doing this.
#
$perm = (stat $file )[2];
$rcs_perm = (stat $RCS_file)[2];
$preserved_uid = chown $uid, -1, $file;
$preserved_gid = chown -1, $gid, $file;
chown $uid, -1, $RCS_file; # make RCS file match working file
chown -1, $gid, $RCS_file;
if ($debug)
{
print "DEBUG do_rcs(): after changing owner:\n";
do_system($LS, $LS_OPTS, $file, $RCS_file);
}
# Hack on setuid and setgid bits, if necessary:
# * If setuid is set, and owner cannot be preserved, clear setuid bit.
# * If setgid is set, and group cannot be preserved, clear setgid bit.
# * If setuid and setgid is set, and either owner or group
# cannot be preserved, clear both the setuid and setgid bits.
#
# This duplicates BSD/OS's security behavior when doing cp -p.
#
$new_perm = $perm;
$new_rcs_perm = $rcs_perm;
if (issetuid($perm))
{
if (issetgid($perm))
{
if (!$preserved_uid || !$preserved_gid)
{
$new_perm &= ~S_ISUID;
$new_perm &= ~S_ISGID;
$new_rcs_perm &= ~S_ISUID;
$new_rcs_perm &= ~S_ISGID;
}
}
elsif (!$preserved_uid)
{
$new_perm &= ~S_ISUID;
$new_rcs_perm &= ~S_ISUID;
}
}
elsif (issetgid($perm) && !$preserved_gid)
{
$new_perm &= ~S_ISGID;
$new_rcs_perm &= ~S_ISGID;
}
chmod $new_perm, $file;
chmod $new_rcs_perm, $RCS_file;
if ($debug)
{
print "DEBUG do_rcs(): after changing permissions:\n";
do_system($LS, $LS_OPTS, $file, $RCS_file);
}
# Print out results of above.
#
if (!$preserved_uid)
{
print "\nWarning, couldn't preserve user! (orig uid = $uid)\n\n";
}
if (!$preserved_gid)
{
print "\nWarning, couldn't preserve group! (orig gid = $gid)\n\n";
}
if (issetuid($perm ^ $new_perm))
{
print "\nWarning, not preserving setuid!\n\n";
}
if (issetgid($perm ^ $new_perm))
{
print "\nWarning, not preserving setgid!\n\n";
}
return 1;
}
#-----------------------------------------------------------------------------
sub do_system
{
if ($debug)
{
print "DEBUG system @_\n";
}
system @_;
if ($CHILD_ERROR == -1)
{
die "failed to execute: $ERRNO\n";
}
elsif (($CHILD_ERROR >> 8) == 255)
{
# On 5.005_03, system never returns -1 if the child couldn't
# execute the program -- it returns 255 instead (and doesn't
# set the errno the child got). Catch that here (which means
# a program that actually returns 255 will be caught here as well
# unfortunately).
die "failed to execute\n";
}
elsif ($CHILD_ERROR & 127)
{
die sprintf("child died with signal %d, %s coredump\n",
($CHILD_ERROR & 127),
($CHILD_ERROR & 128) ? 'with' : 'without');
}
# Return the value the child exited with.
return $CHILD_ERROR >> 8;
}
syntax highlighted by Code2HTML, v. 0.9.1