#!/usr/bin/perl -T
use strict;
########################################
# config files
$nfs_exports::default_options = '*(ro,all_squash,sync,no_subtree_check)';
$nfs_exports::conf_file = '/etc/exports';
$smb_exports::conf_file = '/etc/samba/smb.conf';
my $authorisation_file = '/etc/security/fileshare.conf';
my $authorisation_group = 'fileshare';
########################################
# Copyright (C) 2001-2008 Mandriva (pixel)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
########################################
my $uid = $<;
my $username = getpwuid($uid);
########################################
# errors
my $usage =
"usage: fileshareset --add
fileshareset --remove ";
my $not_enabled =
qq(File sharing is not enabled.
To enable file sharing put
"FILESHARING=yes" in $authorisation_file);
my $not_simple_enabled =
qq(Simple file sharing is not enabled.
To enable simple file sharing put
"SHARINGMODE=simple" in $authorisation_file);
my $non_authorised =
qq(You are not authorised to use fileshare'ing
To grant you the rights:
- put "RESTRICT=no" in $authorisation_file
- or put user "$username" in group "$authorisation_group");
my $no_export_method = "cannot export anything: no nfs, no smb";
my %exit_codes = reverse(
1 => $non_authorised,
2 => $usage,
# when adding
3 => "already exported",
4 => "invalid mount point",
# when removing
5 => "not exported",
6 => $no_export_method,
7 => $not_enabled,
8 => $not_simple_enabled,
255 => "various",
);
################################################################################
# correct PATH needed to call /etc/init.d/... ? seems not, but...
%ENV = ();#(PATH => '/bin:/sbin:/usr/bin:/usr/sbin');
my $modify = $0 =~ /fileshareset/;
authorisation::check($modify);
my @exports = (
-e $nfs_exports::conf_file ? nfs_exports::read() : (),
-e $smb_exports::conf_file ? smb_exports::read() : (),
);
@exports or error($no_export_method);
if ($modify) {
my ($cmd, $dir) = @ARGV;
$< = $>;
@ARGV == 2 && (member($cmd, qw(--add --remove))) or error($usage);
verify_mntpoint($dir);
if ($cmd eq '--add') {
my @errs = map { eval { $_->add($dir) }; $@ } @exports;
grep { !$_ } @errs or error("already exported");
} else {
my @errs = map { eval { $_->remove($dir) }; $@ } @exports;
grep { !$_ } @errs or error("not exported");
}
foreach my $export (@exports) {
$export->write;
$export->update_server;
}
}
my @mntpoints = grep { $_ } uniq(map { map { $_->{mntpoint} } @$_ } @exports);
print "$_\n" foreach grep { own($_) } @mntpoints;
sub own { $uid == 0 || (stat($_[0]))[4] == $uid }
sub verify_mntpoint {
local ($_) = @_;
my $ok = 1;
$ok &&= m|^/|;
$ok &&= !m|\Q/../|;
$ok &&= !m|[\0\n\r]|;
$ok &&= -d $_;
$ok &&= own($_);
$ok or error("invalid mount point");
}
sub error {
my ($string) = @_;
print STDERR "$string\n";
exit($exit_codes{$string} || 255);
}
sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
sub uniq { my %l; $l{$_} = 1 foreach @_; grep { delete $l{$_} } @_ }
################################################################################
package authorisation;
my $F_lock;
sub read_conf {
my ($exclusive_lock) = @_;
open $F_lock, $authorisation_file; # do not care if it's missing
flock($F_lock, $exclusive_lock ? 2 : 1) or die "cannot lock";
my %conf;
foreach (<$F_lock>) {
s/#.*//; # remove comments
s/^\s+//;
s/\s+$//;
/^$/ and next;
my ($cmd, $value) = split('=', $_, 2);
$conf{$cmd} = $value || warn qq(suspicious line "$_" in $authorisation_file\n);
}
# no close $F_lock, keep it locked
\%conf;
}
sub check {
my ($exclusive_lock) = @_;
my $conf = read_conf($exclusive_lock);
if (lc($conf->{FILESHARING}) eq 'no') {
::error($not_enabled);
} elsif (lc($conf->{SHARINGMODE}) eq 'advanced') {
::error($not_simple_enabled);
} elsif ($conf->{FILESHAREGROUP}) {
$authorisation_group = $conf->{FILESHAREGROUP};
} elsif (lc($conf->{RESTRICT}) eq 'no') {
# ok, access granted for everybody
} else {
my @l;
while (@l = getgrent()) {
last if $l[0] eq $authorisation_group;
}
::member($username, split(' ', $l[3])) or ::error($non_authorised);
}
}
################################################################################
package exports;
sub _find {
my ($exports, $mntpoint) = @_;
foreach (@$exports) {
$_->{mntpoint} eq $mntpoint and return $_;
}
undef;
}
sub add {
my ($exports, $mntpoint) = @_;
_find($exports, $mntpoint) and die 'add';
push @$exports, my $e = { mntpoint => $mntpoint };
$e;
}
sub remove {
my ($exports, $mntpoint) = @_;
my @l = grep { $_->{mntpoint} ne $mntpoint } @$exports;
@l < @$exports or die 'remove';
@$exports = @l;
}
################################################################################
package nfs_exports;
use vars qw(@ISA $conf_file $default_options);
BEGIN { @ISA = 'exports' }
sub read() {
my $file = $conf_file;
open(my $F, $file) or return [];
my ($prev_raw, $prev_line, @l);
my $line_nb = 0;
foreach my $raw (<$F>) {
$line_nb++;
local $_ = $raw;
$raw .= "\n" if !/\n/;
s/#.*//; # remove comments
s/^\s+//;
s/\s+$//; # remove unuseful spaces to help regexps
if (/^$/) {
# blank lines ignored
$prev_raw .= $raw;
next;
}
if (/\\$/) {
# line continue across lines
chop; # remove the backslash
$prev_line .= "$_ ";
$prev_raw .= $raw;
next;
}
my $line = $prev_line . $_;
my $raw_line = $prev_raw . $raw;
($prev_line, $prev_raw) = ('', '');
my ($mntpoint, $options) = $line =~ /("[^"]*"|\S+)\s+(.*)/ or die "$file:$line_nb: bad line $line\n";
# You can also specify spaces or any other unusual characters in the
# export path name using a backslash followed by the character code as
# 3 octal digits.
$mntpoint =~ s/\\(\d{3})/chr(oct $1)/ge;
# not accepting weird characters that would break the output
$mntpoint =~ m/[\0\n\r]/ and die "i will not handle this";
push @l, { mntpoint => $mntpoint, option => $options, raw => $raw_line };
}
bless \@l, 'nfs_exports';
}
sub write {
my ($nfs_exports) = @_;
foreach (@$nfs_exports) {
if (!exists $_->{options}) {
$_->{options} = $default_options;
}
if (!exists $_->{raw}) {
my $mntpoint = $_->{mntpoint} =~ /\s/ ? qq("$_->{mntpoint}") : $_->{mntpoint};
$_->{raw} = sprintf("%s %s\n", $mntpoint, $_->{options});
}
}
open(my $F, ">$conf_file") or die "cannot write $conf_file";
print $F $_->{raw} foreach @$nfs_exports;
}
sub update_server() {
if (fork()) {
system('/usr/sbin/exportfs', '-r');
if (system('PATH=/bin:/sbin pidof rpc.mountd >/dev/null') != 0 ||
system('PATH=/bin:/sbin pidof nfsd >/dev/null') != 0) {
# trying to start the server...
system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status >/dev/null') != 0;
system('/etc/init.d/nfs', $_) foreach 'stop', 'start';
}
exit 0;
}
}
################################################################################
package smb_exports;
use vars qw(@ISA $conf_file);
BEGIN { @ISA = 'exports' }
sub read() {
my ($s, @l);
open(my $F, $conf_file);
local $_;
while (<$F>) {
if (/^\s*\[.*\]/ || eof $F) {
#- first line in the category
my ($label) = $s =~ /^\s*\[(.*)\]/;
my ($mntpoint) = $s =~ /^\s*path\s*=\s*(.*)/m;
push @l, { mntpoint => $mntpoint, raw => $s, label => $label };
$s = '';
}
$s .= $_;
}
bless \@l, 'smb_exports';
}
sub write {
my ($smb_exports) = @_;
foreach (@$smb_exports) {
if (!exists $_->{raw}) {
$_->{raw} = <{label}]
path = $_->{mntpoint}
comment = $_->{mntpoint}
public = yes
guest ok = yes
writable = no
wide links = no
EOF
}
}
open(my $F, ">$conf_file") or die "cannot write $conf_file";
print $F $_->{raw} foreach @$smb_exports;
}
sub add {
my ($exports, $mntpoint) = @_;
my $e = $exports->exports::add($mntpoint);
$e->{label} = name_mangle($mntpoint, map { $_->{label} } @$exports);
}
sub name_mangle {
my ($input, @others) = @_;
local $_ = $input;
# 1. first only keep legal characters. "/" is also kept for the moment
tr|a-z|A-Z|;
s|[^A-Z0-9#\-_!/]|_|g; # "$" is allowed except at the end, remove it in any case
# 2. removing non-interesting parts
s|^/||;
s|^home/||;
s|_*/_*|/|g;
s|_+|_|g;
# 3. if size is too small (!), make it bigger
$_ .= "_" while length($_) < 3;
# 4. if size is too big, shorten it
while (length > 12) {
my ($s) = m|.*?/(.*)|;
if (length($s) > 8 && !grep { /\Q$s/ } @others) {
# dropping leading directories when the resulting is still long and meaningful
$_ = $s;
} else {
s|(.*)[0-9#\-_!/]|$1|
# inspired by "Christian Brolin" "Long names are doom" on comp.lang.functional
|| s|(.+)[AEIOU]|$1|# allButFirstVowels
|| s|(.*)(.)\2|$1$2| # adjacentDuplicates
|| s|(.*).|$1|; # booh, :'-(
}
}
# 5. remove "/"s still there
s|/|_|g;
# 6. resolving conflicts
my $l = join("|", map { quotemeta } @others);
my $conflicts = qr|^($l)$|;
if (/$conflicts/) {
A: while (1) {
for (my $nb = 1; length("$_$nb") <= 12; $nb++) {
if ("$_$nb" !~ /$conflicts/) {
$_ = "$_$nb";
last A;
}
}
$_ or die "cannot find a unique name";
# cannot find a unique name, dropping the last letter
s|(.*).|$1|;
}
}
# 7. done
$_;
}
sub update_server() {
if (fork()) {
system('/usr/bin/killall -HUP smbd 2>/dev/null');
if (system('PATH=/bin:/sbin pidof smbd >/dev/null') != 0 ||
system('PATH=/bin:/sbin pidof nmbd >/dev/null') != 0) {
# trying to start the server...
my ($f) = grep { -f $_ } map { "/etc/init.d/$_" } 'smb', 'samba', 'rc.samba';
if ($f) {
system($f, $_) foreach 'stop', 'start';
} else {
print STDERR "Error: Can't find the samba init script \n";
}
}
exit 0;
}
}
}Ͱ4!}T=Xvh.Fd ʧ݈gGh Z[*96hQ/_UvLR&B@OVCy^]qM;F|S&UyOxczބCV0o2Xk>'kߗ*\Zx65 d6ȅ$z l/X//Zhdj,loZY܊ojfW@Zs;es;߽%FS!0аA?N:%tu-z!Џu,
{";t{9-W$^ui+jہeTpvZzWŭ`uP&9C[x:`ok:q\OmrH>\)+PtitfkyuH6^Nh ȣɻ4Rd"5#vKE'E~TɸF暥
fItJ@qCN5|v{@G=iǼ;PhXj8d(^Ŭ
6ҊEO~fڴ'ˊ|=aݬGKP] Rk!e>03je։lCoQd{n]d7N9I wHZ0mw_' )BhZE n=GF/Q˵IYYs'4M*kGj~z{a,p0g"p5,ֵhaÈ^FYY+GK ))|W]Ju\˾\ UpjK{!l $q|;UMȄf/֝H^s!vW4|V5QPJA#@qm[۰5[~
N3Č01{r nAҭR0zJ]}Aá4%%c@Qx'\! H쇺NZ nP2U*.&@YL-X3bd\IZ0mFT0c~2D((z/8)Jub8SjG]5b&uMa ;GNV[x՞Bh-v{AB$f1Lnq4O%(Hw:
c7:4ItH%7v \qtڢv
5ӭ,ԕ*L@m&`]ccԮP"GO:P/-Y
4Hem3qQAb>#ORS*%RIX&vW:Bc%+A<5`CBJ`OzӪfᅲHbyz#'HM }z2˯VZCu!օ0ʾbJ ҝm{o?d^̡{^CۙG@X%crPen3`_D?-JZ6).%-]*i:YkbGM^BhƵT= u$Y
"?i;˨@1S,S
ɼg
E+8p7mMi^ٮn(Tj\gXP8B*()4A&/`^8o @ܢ )jJ( ;9熹L|{ٔw >0ځN0; g1#w_)|`9IdO{XZIJ'E˸3AY^=ɱ)tM* )Knb^ݎzͦƉ3CXs#{@,҈98uLrм#nu8
PZnu`Au\nEYI^0ވ/6)'2!Q#ƶaL ۋ3'U u Ibh%)Դ't˞и*X;^:h)gU*;GiřR]UEur"R}ۑ}BϬxGSW|e§s"6Y6:$+Gt{e[DO4@!m!v"8PߦMҭQaXVAy#ۺ%fX_Pbu'Gh6V,xDlrJN"h}41|[DM l_uLtjhz92p$rz4a9zeQ}qFl#Bi<)vX2<.|d=i33#MbΤ
4#o|w!
[lKr am5J w~iN,%ދԠ@Yih]rSj.gz'yeykx!x0Il 7G'Wg54iع(cxW+4A/Q:ol) ]~4x
T Vרbsȅft0.!RUU ^vU%cm2NUh>O)]]V Tb|]7T|sh"et i34͖%1;ȿNjLE7[7Cl^ fѸD al2z%{pJ_|9eGi%.l+9>}MNۖgCHO~
(VgEkc65jɌStk8 ^H0T'F1Xz* .oD`Q?#ÃǗK0r|Rb5ţ6ׄ.hq+7|F8$*ȩAG;*Eh3G7o!'ؘB#̉%K{vh VaOPLp7_q$V"seW:Y3R#V(`J肒1~ZT ;
;778o(H7Z}.vXdj;
-qr
^BoԽucIA
=uȳ<,Uyds8*qx>v^Dl&~dGm=ʨf:*yy)u"&'nAS
mm2jnOAkۨQKEtnKavJ^ *~_=,8-F{RR:bbNS_lmLiyH}pwq6.`['M5{%uܓ7UMjt,CL~e*mܾi#U֚OhxhK{n2wB^)4oaխy*6OpMt<$+h ipM<ۀgQNݙY?yd_44Yv8Q"zQ-('MB
i"YzݓU.&]I7zB!=_
%Fxࣁs>KFl^_[bA*!jSUP@`9ϡ$~~!%ѯgkix9 iCv E}
]
@,ڇmt^,vqQKx,ϐ1,)pVz(SL1sԑ*ۃ>fgU,9S3
r%U$'H8'@OmL~-UG,``thu_q"7㔈ͤrjm^随b]r$}ZWmǑo*Qf%[.I0OuæO#FRwxe| bwgL_X Eq9 I2q`|*_J>]upSҴvἢިVS>%+FH"\Ň_!̰ n0ȹ IwQ}mb>5z"/"@˫֟(wPkZZ
;>HŴԂ(7˜j4pĒY:h_)1EQ7NL}Ζs/*O1iAF-Wi5hQPvtpݑ=X}XטH8kBTl%JWeݷe]WN \i %'
؋4_v%$
f|u#2*H ouUL '=iw,qj^j.MI b"r"f Оٔ"\6UqQ
#ݘtyIaʯ<'FݩWw7,U("Ux(e[|p:4<$ Bfk&Ɣm<fd\T^ٺչ!2ޖtb"PGUKQxE@bz.moiDqK16*(о*Lyy,z-K>O285H@),(T$I5NL_դ֎ZCqݙ2FHQE9lFcz^Y/Sw~@K0+J]sCqM"a8XD[dVCXrдq왧ɯk3Ajk^֗U~8Z䁜Mh "16V0_*4f-[6> PȰ\3)`IqosmKb;e
RG[~κV1;0AtW@!nNh'$jD5쐪
HX:@/@Ix?P)1ƃRXWB8>l(:zfsלP_8twƮETe@MZrT63E фld֦pj 3>1uc
;-R)zK?'fV貙]˲XX}kv^foDZTnl'ƛ$0&UB9(ʾ#^&o@%
MhK 5aT%V ex`ܔ2n3v$MN5C+=&|
,5* >En `SG|
Pfᡘ㐚ٝ
(tA`0u1 AQ02~d,nGPޏW H77[xm;@ϧ\`"`xNKr|;osLYRG!R(h6p#xuoE$x ZuЊxh/T#Cr20ٞyW?wcsNUp8xy#ϰ_IS} 3u+_7V3eͷzqUL)rOUXcz>sXZRωV[c
wg1`FA=;ޔePHu\/Lj6sB G]8㷽q@S.
KW`G5Azm!ɾ7\7=:j)"YNY1p(tͦ.HGmЩOy3wɃVkD\qFZP({F9Kfk$AtX$x'7BwWDZD1$[:}=Q~q
fU^).
L$v*LfznisN~g R=i ;2M
0Bbmcԗ!qƑۺ"P&CdS*譁NAx-6*!oyˁW+png6̡`$$̃m#wbMw1㍀--*"(.}}t끌ZaeYzzPO :H) 0N5"҄S:ۘ/ڸ"Sp6lϠgDʟ:y`THJA8Q>okhfJWR(OXT:w(Tt[T#8
.;{s\v_>M<"VhGTǷ
/d;gNf66Q~]ldcgӼTru83_PxiWh9=r
|\֛w@Etd$.1O ֗<ꡌܝXߖFD90bd )P!1pD ȺT#g6XhZ0O"u_';KT4W3>Y>^3d*Osŀ鹥 0wvy
iRT.0uEy!K33xx0DY=4~EJ
.f}`6w>#Y䋏O2G<,-PT֪4'Ѯ `><86UZwnO(c~,>#v.#߶L!n1*s
?`K]8i=0//aZ_O[گyHm-) `;/M1dzbY06A|NDܔZl"