##! /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.