##! /usr/local/bin/perl
# Set the first line to point to Perl, and remove the leading '#'.
#
# p4protect
# $Id$
# Chuck Karish
# karish@well.com
#
# Write a Perforce protections table, filling in the numbers for
# granting IP-number-based capabilities.
#
# Usage: perl p4protect.pl < <permissions> | p4 protect -i
#
# Syntax of the <permissions> file:
#
# comment "<message text>" ["<message text>" ... ]
#
# addline "<mode> {user | group} <name> HOST <path>" <hostlist>
# Specify one permission line that will apply for the
# hosts in <hostlist>.
#
# archive <path> <hostlist>
# Make all files in <path> read-only to everyone.
#
# freeze <path> <hostlist> <writegroup> <opengroup>
# Restrict access to <path>:
# write access for <writegroup>
# open access for <opengroup> - check out but no submit
# read access for everyone
#
# sethosts "<hostnum> [ <hostnum> ...]"
# Set the default list of hosts or subnets to which the directives
# that follow in the <permissions> file will apply. Used if the
# <hostlist> argument is an empty string ("").
#
# <hostnum>
# IP address, dotted-decimal (x.x.x.x). Any octet may be replaced
# by a '*' to specify a subnet. A single '*' allows access to all
# hosts.
#
# <hostlist>
# "<hostnum> [<hostnum> ... ]"
# A quoted, blank-seprated list of <hostnum> entries.
#
# Blank lines, lines containing only white space, and lines
# on which the first printing characer is '#' are ignored.
#
use strict;
use Text::ParseWords;
# Default Host: any.
my $hosts = ("*");
# printheader: Get the comment header from "p4 protect -o", to be used
# as input to "p4 protect -i".
sub printheader{
open(PROT, "p4 protect -o |") or die "Error from \"protect -o\"";
while (<PROT>) {
print;
if ($_ =~ /^Protections:/) {
last;
}
};
close(PROT);
}
# checkparms: Make sure we have the expected number of parameters.
sub checkparms{
my ($func, $want, $have, $line) = @_;
if ($want != $have) {
chomp $line;
printf STDERR "$func: $have parameters, not $want: $line\n";
0;
} else {
1;
}
}
# protectprintf: Print a Perforce protection string.
# Type "p4 help protect" for more information.
# $1: mode
# $2: group/user indicator
# $3: name
# $4: host
# $5: path
sub protectprintf{
chomp;
my ($line) = @_;
my @args = &shellwords(@_);
if (checkparms "protectprintf", 5, (my $c = @args), $line) {
printf " $line\n";
} else {
foreach my $arg (@args) {
chomp $arg;
printf STDERR "debug: $arg\n"
}
}
}
# Update the default hosts list.
# $1: A blank-separated list of IP numbers.
sub sethosts{
checkparms("sethosts", 1, (my $c = @_), $_) or return;
($hosts) = @_;
}
# Print a blank line followed by a bogus permission line with the
# comment text in the last field (path).
# $1: Free-form comment text
sub printcomment{
my $comment = "";
print "\n";
foreach $comment (@_) {
$_=$comment;
s/\s+/_/g;
protectprintf "read group * * -//depot/REM/$_";
}
}
# Print a line for each of the hosts for which access should be set.
# $1: Protect specification line, with 'HOST' in place of the host field
# $2: List of hosts to be plugged in
sub addhosts{
my ($line, $numlist) = @_;
checkparms "addhosts", 2, (my $c = @_), $_ or return;
if ($numlist =~ m/""/) {
$numlist = $hosts;
}
my $host = "";
foreach $host (split(/\s+/, $numlist)) {
$_ = $line;
s/HOST/$host/;
protectprintf $_;
}
}
# Set read-only access for all users and groups.
# $1: Filespec to be protected (depot syntax).
# $2: List of hosts to be plugged in (for read access)
sub archive{
my ($line, $numlist) = @_;
checkparms "archive", 2, (my $c = @_), $_ or return;
freeze($line, $numlist, "", "");
}
# Freeze a path. Allow access only to specified groups.
# $1: The path to be frozen, in depot syntax.
# $2: List of hosts to be plugged in
# $3: The group that has "write" access.
# $4: The group that has "open" access.
sub freeze{
my ($spec, $numlist, $writegroup, $opengroup) = @_;
checkparms "freeze", 4, (my $c = @_), $_ or return;
if ($numlist =~ m//) {
$numlist = $hosts;
}
protectprintf ("write user * * -$spec");
if ($writegroup ne "") {
addhosts ("write group $writegroup HOST $spec", $numlist);
}
if ($opengroup ne "") {
addhosts ("open group $opengroup HOST $spec", $numlist);
}
addhosts ("read user * HOST $spec", $numlist);
}
# Begin main program.
printheader;
while (<STDIN>) {
chomp;
if (/^\s*#/ || /^$/){
next;
}
my @args = &shellwords($_);
if ($args[0] eq "addline"){
shift @args;
addhosts @args;
next;
}
if ($args[0] eq "archive"){
shift @args;
archive @args;
next;
}
if ($args[0] eq "comment"){
shift @args;
printcomment @args;
next;
}
if ($args[0] eq "freeze"){
shift @args;
freeze @args;
next;
}
if ($args[0] eq "sethosts"){
$args[1];
next;
}
printf STDERR "p4protect.pl: What's this? $_\n";
}
# End main program.