[userv-utils] / ipif / service-wrap

#!/usr/bin/perl -w
#
# When invoked appropriately, it creates a point-to-point network
# interface with specified parameters.  It arranges for packets sent out
# via that interface by the kernel to appear on its own stdout in SLIP or
# CSLIP encoding, and packets injected into its own stdin to be given to
# the kernel as if received on that interface.  Optionally, additional
# routes can be set up to arrange for traffic for other address ranges to
# be routed through the new interface.
# 
# This is the access control wrapper for the service program.
# Arrangments should be made to invoke this as root from userv.
#
# Usage:
#
#   .../ipif1 <v1config> <real-service-program> -- <service-args>...
#
# Config file is a series of lines.
#
#   permit <keyword>....
#
#      if caller, local addr, all remote addrs and networks, and
#      ifname, all match, permits the request (and stops reading
#      the config)
#
#          group <groupname>|<gid>
#              matches caller if they are in that group
#          user <username>|<uid>
#              matches caller if they are that user
#          everyone
#              always matches caller
#
#          hostnet <ipaddr>/<prefixlen>
#              equivalent to   local <ipv4addr> remote <ipv4addr&prefix>
#          local <ipaddr>
#              matches local address when it is <ipv4addr>
#          remote <ipnetnet>/<prefixlen>
#              matches aplicable remote addrs (including p-t-p)
#          addrs <ipaddr>|<ipnetnet>/<prefixlen>
#              matches applicable local ore remote addrs
#
#          ifname <ifname>
#              matches interface name if it is exactly <ifname>
#              (<ifname> may contain %d, which is interpreted by
#              the kernel)
#              wildcards are not supported
#              if a permit has no ifname at all, it is as if
#              `ifname userv%d' was specified
#
#   include <other-config-file>
#
#   v0config <v0configfile>
#
#     If none of the `permit' lines match, will read <v0configfile>
#     in old format.  Must come after all `permit' lines.
#
#   <config> --

use strict;
use POSIX;
use Carp;
use NetAddr::IP::Lite qw(:nofqdn :lower);

our $default_ifname = 'userv%d';

sub badusage ($) {
    my ($m) = @_;
    die "bad usage: $m\n";
}

sub oneaddr ($) {
    my ($ar) = @_;
    my $x = $$ar;
    $x // badusage "missing IP address";
    $x = new NetAddr::IP::Lite $x // badusage "bad IP address";
    $x->masklen == $x->bits or badusage "IP network where addr expected";
    die if $x->addr =~ m,/,;
    $$ar = $x;
}

@ARGV == 5 or badusage "wrong number of arguments";
our ($v1config, $realservice, $sep, $addrsarg, $rnets) = @ARGV;

$sep eq '--' or badusage "separator should be \`--'";
my ($local_addr, $peer_addr, $mtu, $protocol, $ifname) =
    split /\,/, $addrsarg;

oneaddr \$local_addr;
oneaddr \$peer_addr;
$mtu = 1500 unless length $mtu;
$mtu =~ m/^[1-9]\d{1,4}/ or badusage "bad mtu";
$mtu += 0;

$protocol = 'slip' unless length $protocol;
$protocol =~ m/\W/ and badusage "bad protocol";

$ifname = $default_ifname unless length $ifname;

our @rnets = ($rnets eq '-' ? () : split /\,/, $rnets);
@rnets = map { new NetAddr::IP::Lite $_ } @rnets;


sub execreal ($) {
    my ($use_v0config) = @_;
    exec $realservice, $use_v0config, '--',
	(join ',', $local_addr->addr, $peer_addr->addr,
	           $mtu, $protocol, $ifname),
	@rnets ? (join ",", map { "$_" } @rnets) : "-"
	or die "exec $realservice: $!\n";
}

our $v0config;

our $cfgpath;

sub badcfg ($) {
    my ($m) = @_;
    die "bad configuration: $cfgpath:$.: $m\n";
}

our %need_allow;
# $need_allow{CLASS}[]
# $need_allow{CLASS}[]{Desc}   # For error messages
# $need_allow{CLASS}[]{Allow}  # Starts out nonexistent
# $need_allow{CLASS}[]{IpAddr} # CLASS eq Local or Remote only

sub allowent ($@) {
    my ($desc, @xtra) = @_;
    return { Desc => $desc, @xtra };
}
sub allowent_addr ($$) {
    my ($what, $addr) = @_;
    return allowent "$what $addr", IpAddr => $addr;
}
sub need_allow_item ($$) {
    my ($cl, $ne) = @_;
    push @{ $need_allow{$cl} }, $ne
}
sub need_allow_singleton ($$) {
    my ($cl, $ne) = @_;
    $need_allow{$cl} ||= [ $ne ];
}

sub maybe_allow__entry ($$) {
    my ($ne, $yes) = @_;
    $ne->{Allowed} ||= $yes;
}
sub maybe_allow_singleton ($$) {
    my ($cl, $yes) = @_;
    my $ents = $need_allow{$cl};
    die $cl unless @$ents==1;
    maybe_allow__entry $ents->[0], $yes;
}
sub default_allow_singleton ($$) {
    # does nothing if maybe_allow_singleton was called for this $cl;
    # otherwise allows the singleton iff $yes
    my ($cl, $yes) = @_;
    my $ents = $need_allow{$cl};
    die $cl unless @$ents==1;
    $ents->[0]{Allowed} //= $yes;
}
sub maybe_allow_caller_env ($$$) {
    my ($spec, @envvars) = @_;
    foreach my $envvar (@envvars) {
	my $val = $ENV{$envvar} // die $envvar;
	my @vals = split / /, $val;
	#use Data::Dumper; print Dumper($spec,$envvar,\@vals);
	maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals;
    }
}
sub maybe_allow_addrs ($$) {
    my ($cl, $permitrange) = @_;
    foreach my $ne (@{ $need_allow{$cl} }) {
	confess unless defined $ne->{IpAddr};
	maybe_allow__entry $ne, $permitrange->contains($ne->{IpAddr});
    }
}

sub readconfig ($) {
    local ($cfgpath) = @_;
    my $cfgfh = new IO::File $cfgpath, "<";
    if (!$cfgfh) {
	die "$0: $cfgpath: $!\n" unless $!==ENOENT;
	return;
    }
    while (<$cfgfh>) {
	s/^\s+//;
	s/\s+$/\n/;
	next if m/^\#/;
	next unless m/\S/;
	if (s{^permit\s+}{}) {
	    badcfg "v0config before permit" if defined $v0config;
	    %need_allow = ();
	    need_allow_singleton 'Caller', allowent 'caller';
	    need_allow_singleton 'Local',
		allowent_addr "local interface", $local_addr;
	    need_allow_singleton 'Ifname', allowent 'interface name';
	    need_allow_item 'Remote',
		allowent_addr "peer point-to-point addr", $peer_addr;
	    foreach (@rnets) {
		need_allow_item 'Remote',
		    allowent_addr "remote network", $_;
	    }
	    #use Data::Dumper; print Dumper(\%need_allow);
	    while (m{\S}) {
		if (s{^user\s+(\S+)\s+}{}) {
		    maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID';
		} elsif (s{^group\s+(\S+)\s+}{}) {
		    maybe_allow_caller_env $1, 'USERV_GROUP', 'USERV_GID';
		} elsif (s{^everyone\s+}{}) {
		    maybe_allow_singleton 'Caller', 1;
		} elsif (s{^hostnet\s+(\S+/\d+)\s+}{}) {
		    my $hn = new NetAddr::IP::Lite $1 or
			badcfg "invalid ip address in hostnet";
		    my $host = new NetAddr::IP::Lite $hn->addr or die;
		    my $net = $hn->network() or die;
		    maybe_allow_addrs 'Local', $host;
		    maybe_allow_addrs 'Remote', $net;
		} elsif (s{^(local|remote|addrs)\s+(\S+)\ s+}{}) {
		    my $h = $1;
		    my $s = new NetAddr::IP::Lite $2 or
			badcfg "invalid ip address or mask in $h";
		    maybe_allow_addrs 'Local', $s if $h =~ m/addrs|local/;
		    maybe_allow_addrs 'Remote', $s if $h =~ m/addrs|remote/;
		} elsif (s{^ifname\s+(\S+)\s+}{}) {
		    my ($spec) = $1;
		    maybe_allow_singleton 'Ifname', $ifname eq $spec;
		} elsif (m{^\S+}) {
		    badcfg "unknown keyword in permit \`$1'";
		} else {
		    die;
		}
	    }
	    default_allow_singleton 'Ifname', $ifname eq $default_ifname;
	    my @wrong;
	    foreach my $clval (values %need_allow) {
		foreach my $ne (@$clval) {
		    next if $ne->{Allowed};
		    push @wrong, $ne->{Desc};
		}
	    }
	    if (!@wrong) {
		# yay!
		if ($protocol eq 'debug') {
		    print "config $cfgpath:$.: matches\n";
		    exit 0;
		}
		execreal '*';
	    }
	    if ($protocol eq 'debug') {
		#use Data::Dumper; print Dumper(\%need_allow);
		print "config $cfgpath:$.: mismatch: $_\n"
		    foreach @wrong;
	    }
	} elsif (m{^v0config\s+(\S+)$}) {
	    badcfg "repeated v0config" if defined $v0config;
	    $v0config = $1;
	} elsif (m{^include\s+(\S+)$}) {
	    readconfig $1;
	} else {
	    badcfg "unknown config directive or bad syntax";
	}
    }
    $cfgfh->error and die $!;
    close $cfgfh;

    if (defined $v0config) {
	$v0config =~ s{^}{./} unless $v0config =~ m{^/};
	print "trying v0 config $v0config...\n" if $protocol eq 'debug';
	execreal $v0config;
    }
    die "permission denied\n";
}

readconfig $v1config;
Commit	Line	Data
08e5c1c8 IJ	1	#!/usr/bin/perl -w
	2	#
	3	# When invoked appropriately, it creates a point-to-point network
	4	# interface with specified parameters. It arranges for packets sent out
	5	# via that interface by the kernel to appear on its own stdout in SLIP or
	6	# CSLIP encoding, and packets injected into its own stdin to be given to
	7	# the kernel as if received on that interface. Optionally, additional
	8	# routes can be set up to arrange for traffic for other address ranges to
	9	# be routed through the new interface.
	10	#
	11	# This is the access control wrapper for the service program.
	12	# Arrangments should be made to invoke this as root from userv.
	13	#
	14	# Usage:
	15	#
44b7fe58	16	# .../ipif1 <v1config> <real-service-program> -- <service-args>...
08e5c1c8 IJ	17	#
	18	# Config file is a series of lines.
	19	#
	20	# permit <keyword>....
	21	#
	22	# if caller, local addr, all remote addrs and networks, and
	23	# ifname, all match, permits the request (and stops reading
	24	# the config)
	25	#
	26	# group <groupname>\|<gid>
	27	# matches caller if they are in that group
	28	# user <username>\|<uid>
	29	# matches caller if they are that user
	30	# everyone
	31	# always matches caller
	32	#
	33	# hostnet <ipaddr>/<prefixlen>
	34	# equivalent to local <ipv4addr> remote <ipv4addr&prefix>
	35	# local <ipaddr>
	36	# matches local address when it is <ipv4addr>
	37	# remote <ipnetnet>/<prefixlen>
	38	# matches aplicable remote addrs (including p-t-p)
	39	# addrs <ipaddr>\|<ipnetnet>/<prefixlen>
	40	# matches applicable local ore remote addrs
	41	#
	42	# ifname <ifname>
	43	# matches interface name if it is exactly <ifname>
	44	# (<ifname> may contain %d, which is interpreted by
	45	# the kernel)
	46	# wildcards are not supported
	47	# if a permit has no ifname at all, it is as if
	48	# `ifname userv%d' was specified
	49	#
44b7fe58 IJ	50	# include <other-config-file>
44b7fe58 IJ	51	#
08e5c1c8 IJ	52	# v0config <v0configfile>
	53	#
	54	# If none of the `permit' lines match, will read <v0configfile>
44b7fe58	55	# in old format. Must come after all `permit' lines.
08e5c1c8 IJ	56	#
	57	# <config> --
	58
	59	use strict;
8ca56de8 IJ	60	use POSIX;
8ca56de8 IJ	61	use Carp;
44b7fe58	62	use NetAddr::IP::Lite qw(:nofqdn :lower);
44b7fe58 IJ	63
	64	our $default_ifname = 'userv%d';
	65
8ca56de8 IJ	66	sub badusage ($) {
	67	my ($m) = @_;
	68	die "bad usage: $m\n";
	69	}
	70
44b7fe58 IJ	71	sub oneaddr ($) {
44b7fe58 IJ	72	my ($ar) = @_;
8ca56de8	73	my $x = $$ar;
44b7fe58 IJ	74	$x // badusage "missing IP address";
	75	$x = new NetAddr::IP::Lite $x // badusage "bad IP address";
	76	$x->masklen == $x->bits or badusage "IP network where addr expected";
	77	die if $x->addr =~ m,/,;
	78	$$ar = $x;
	79	}
	80
	81	@ARGV == 5 or badusage "wrong number of arguments";
	82	our ($v1config, $realservice, $sep, $addrsarg, $rnets) = @ARGV;
	83
	84	$sep eq '--' or badusage "separator should be \`--'";
	85	my ($local_addr, $peer_addr, $mtu, $protocol, $ifname) =
	86	split /\,/, $addrsarg;
	87
	88	oneaddr \$local_addr;
	89	oneaddr \$peer_addr;
	90	$mtu = 1500 unless length $mtu;
	91	$mtu =~ m/^[1-9]\d{1,4}/ or badusage "bad mtu";
	92	$mtu += 0;
	93
	94	$protocol = 'slip' unless length $protocol;
	95	$protocol =~ m/\W/ and badusage "bad protocol";
	96
	97	$ifname = $default_ifname unless length $ifname;
	98
	99	our @rnets = ($rnets eq '-' ? () : split /\,/, $rnets);
	100	@rnets = map { new NetAddr::IP::Lite $_ } @rnets;
	101
8ca56de8 IJ	102
	103	sub execreal ($) {
	104	my ($use_v0config) = @_;
	105	exec $realservice, $use_v0config, '--',
0d8db366 IJ	106	(join ',', $local_addr->addr, $peer_addr->addr,
0d8db366 IJ	107	$mtu, $protocol, $ifname),
8ca56de8 IJ	108	@rnets ? (join ",", map { "$_" } @rnets) : "-"
	109	or die "exec $realservice: $!\n";
	110	}
	111
	112	our $v0config;
	113
	114	our $cfgpath;
	115
	116	sub badcfg ($) {
	117	my ($m) = @_;
	118	die "bad configuration: $cfgpath:$.: $m\n";
	119	}
	120
44b7fe58 IJ	121	our %need_allow;
	122	# $need_allow{CLASS}[]
	123	# $need_allow{CLASS}[]{Desc} # For error messages
	124	# $need_allow{CLASS}[]{Allow} # Starts out nonexistent
	125	# $need_allow{CLASS}[]{IpAddr} # CLASS eq Local or Remote only
	126
8ca56de8	127	sub allowent ($@) {
44b7fe58 IJ	128	my ($desc, @xtra) = @_;
	129	return { Desc => $desc, @xtra };
	130	}
8ca56de8 IJ	131	sub allowent_addr ($$) {
	132	my ($what, $addr) = @_;
	133	return allowent "$what $addr", IpAddr => $addr;
	134	}
	135	sub need_allow_item ($$) {
	136	my ($cl, $ne) = @_;
	137	push @{ $need_allow{$cl} }, $ne
44b7fe58 IJ	138	}
44b7fe58 IJ	139	sub need_allow_singleton ($$) {
8ca56de8 IJ	140	my ($cl, $ne) = @_;
8ca56de8 IJ	141	$need_allow{$cl} \|\|= [ $ne ];
44b7fe58 IJ	142	}
	143
	144	sub maybe_allow__entry ($$) {
	145	my ($ne, $yes) = @_;
	146	$ne->{Allowed} \|\|= $yes;
	147	}
8ca56de8	148	sub maybe_allow_singleton ($$) {
44b7fe58 IJ	149	my ($cl, $yes) = @_;
	150	my $ents = $need_allow{$cl};
	151	die $cl unless @$ents==1;
8ca56de8	152	maybe_allow__entry $ents->[0], $yes;
44b7fe58 IJ	153	}
	154	sub default_allow_singleton ($$) {
	155	# does nothing if maybe_allow_singleton was called for this $cl;
	156	# otherwise allows the singleton iff $yes
	157	my ($cl, $yes) = @_;
	158	my $ents = $need_allow{$cl};
	159	die $cl unless @$ents==1;
	160	$ents->[0]{Allowed} //= $yes;
	161	}
8ca56de8	162	sub maybe_allow_caller_env ($$$) {
44b7fe58 IJ	163	my ($spec, @envvars) = @_;
	164	foreach my $envvar (@envvars) {
	165	my $val = $ENV{$envvar} // die $envvar;
	166	my @vals = split / /, $val;
8ca56de8	167	#use Data::Dumper; print Dumper($spec,$envvar,\@vals);
44b7fe58 IJ	168	maybe_allow_singleton 'Caller', !!grep { $_ eq $spec } @vals;
	169	}
	170	}
8ca56de8	171	sub maybe_allow_addrs ($$) {
44b7fe58 IJ	172	my ($cl, $permitrange) = @_;
44b7fe58 IJ	173	foreach my $ne (@{ $need_allow{$cl} }) {
8ca56de8 IJ	174	confess unless defined $ne->{IpAddr};
8ca56de8 IJ	175	maybe_allow__entry $ne, $permitrange->contains($ne->{IpAddr});
44b7fe58 IJ	176	}
	177	}
	178
	179	sub readconfig ($) {
8ca56de8 IJ	180	local ($cfgpath) = @_;
8ca56de8 IJ	181	my $cfgfh = new IO::File $cfgpath, "<";
44b7fe58 IJ	182	if (!$cfgfh) {
	183	die "$0: $cfgpath: $!\n" unless $!==ENOENT;
	184	return;
	185	}
	186	while (<$cfgfh>) {
	187	s/^\s+//;
	188	s/\s+$/\n/;
	189	next if m/^\#/;
	190	next unless m/\S/;
	191	if (s{^permit\s+}{}) {
	192	badcfg "v0config before permit" if defined $v0config;
8ca56de8 IJ	193	%need_allow = ();
	194	need_allow_singleton 'Caller', allowent 'caller';
	195	need_allow_singleton 'Local',
	196	allowent_addr "local interface", $local_addr;
	197	need_allow_singleton 'Ifname', allowent 'interface name';
	198	need_allow_item 'Remote',
	199	allowent_addr "peer point-to-point addr", $peer_addr;
44b7fe58	200	foreach (@rnets) {
8ca56de8 IJ	201	need_allow_item 'Remote',
8ca56de8 IJ	202	allowent_addr "remote network", $_;
44b7fe58	203	}
8ca56de8	204	#use Data::Dumper; print Dumper(\%need_allow);
44b7fe58	205	while (m{\S}) {
8ca56de8	206	if (s{^user\s+(\S+)\s+}{}) {
44b7fe58	207	maybe_allow_caller_env $1, 'USERV_USER', 'USERV_UID';
8ca56de8	208	} elsif (s{^group\s+(\S+)\s+}{}) {
44b7fe58 IJ	209	maybe_allow_caller_env $1, 'USERV_GROUP', 'USERV_GID';
	210	} elsif (s{^everyone\s+}{}) {
	211	maybe_allow_singleton 'Caller', 1;
	212	} elsif (s{^hostnet\s+(\S+/\d+)\s+}{}) {
8ca56de8	213	my $hn = new NetAddr::IP::Lite $1 or
44b7fe58 IJ	214	badcfg "invalid ip address in hostnet";
	215	my $host = new NetAddr::IP::Lite $hn->addr or die;
	216	my $net = $hn->network() or die;
	217	maybe_allow_addrs 'Local', $host;
8ca56de8	218	maybe_allow_addrs 'Remote', $net;
44b7fe58 IJ	219	} elsif (s{^(local\|remote\|addrs)\s+(\S+)\ s+}{}) {
	220	my $h = $1;
	221	my $s = new NetAddr::IP::Lite $2 or
	222	badcfg "invalid ip address or mask in $h";
	223	maybe_allow_addrs 'Local', $s if $h =~ m/addrs\|local/;
	224	maybe_allow_addrs 'Remote', $s if $h =~ m/addrs\|remote/;
	225	} elsif (s{^ifname\s+(\S+)\s+}{}) {
	226	my ($spec) = $1;
	227	maybe_allow_singleton 'Ifname', $ifname eq $spec;
	228	} elsif (m{^\S+}) {
	229	badcfg "unknown keyword in permit \`$1'";
	230	} else {
	231	die;
	232	}
	233	}
	234	default_allow_singleton 'Ifname', $ifname eq $default_ifname;
	235	my @wrong;
	236	foreach my $clval (values %need_allow) {
	237	foreach my $ne (@$clval) {
8ca56de8	238	next if $ne->{Allowed};
44b7fe58 IJ	239	push @wrong, $ne->{Desc};
	240	}
	241	}
	242	if (!@wrong) {
	243	# yay!
	244	if ($protocol eq 'debug') {
8ca56de8	245	print "config $cfgpath:$.: matches\n";
44b7fe58 IJ	246	exit 0;
44b7fe58 IJ	247	}
8ca56de8	248	execreal '*';
44b7fe58 IJ	249	}
44b7fe58 IJ	250	if ($protocol eq 'debug') {
8ca56de8 IJ	251	#use Data::Dumper; print Dumper(\%need_allow);
8ca56de8 IJ	252	print "config $cfgpath:$.: mismatch: $_\n"
44b7fe58 IJ	253	foreach @wrong;
	254	}
	255	} elsif (m{^v0config\s+(\S+)$}) {
	256	badcfg "repeated v0config" if defined $v0config;
	257	$v0config = $1;
	258	} elsif (m{^include\s+(\S+)$}) {
	259	readconfig $1;
	260	} else {
	261	badcfg "unknown config directive or bad syntax";
	262	}
	263	}
	264	$cfgfh->error and die $!;
	265	close $cfgfh;
8ca56de8 IJ	266
	267	if (defined $v0config) {
	268	$v0config =~ s{^}{./} unless $v0config =~ m{^/};
	269	print "trying v0 config $v0config...\n" if $protocol eq 'debug';
	270	execreal $v0config;
	271	}
	272	die "permission denied\n";
44b7fe58 IJ	273	}
44b7fe58 IJ	274
8ca56de8	275	readconfig $v1config;