diff options
Diffstat (limited to 'perl-install/standalone/fileshareset')
| -rwxr-xr-x | perl-install/standalone/fileshareset | 389 |
1 files changed, 0 insertions, 389 deletions
diff --git a/perl-install/standalone/fileshareset b/perl-install/standalone/fileshareset deleted file mode 100755 index 3b5523f26..000000000 --- a/perl-install/standalone/fileshareset +++ /dev/null @@ -1,389 +0,0 @@ -#!/usr/bin/perl -T -use strict; - -######################################## -# config files -$nfs_exports::default_options = '*(ro,all_squash,sync)'; -$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'; - - -######################################## -# fileshare utility $Id$ -# Copyright (C) 2001-2004 MandrakeSoft (pixel@mandrakesoft.com) -# -# 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 <dir> - fileshareset --remove <dir>"; -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 = "can't 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, - - 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 && ($cmd eq '--add' || $cmd eq '--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; - -sub read_conf { - my ($exclusive_lock) = @_; - open F_lock, $authorisation_file; # don't care if it's missing - flock(F_lock, $exclusive_lock ? 2 : 1) or die "can't 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->{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) = @_; - foreach (@$exports) { - $_->{mntpoint} eq $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; - local *F; - open 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 won't 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}); - } - } - local *F; - open F, ">$conf_file" or die "can't write $conf_file"; - print F $_->{raw} foreach @$nfs_exports; -} - -sub update_server() { - if (fork()) { - system('/usr/sbin/exportfs', '-r'); - if (system('/sbin/pidof rpc.mountd >/dev/null') != 0 || - system('/sbin/pidof nfsd >/dev/null') != 0) { - # trying to start the server... - system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status') != 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); - local *F; - open 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} = <<EOF; - -[$_->{label}] - path = $_->{mntpoint} - comment = $_->{mntpoint} - public = yes - guest ok = yes - writable = no - wide links = no -EOF - } - } - local *F; - open F, ">$conf_file" or die "can't 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; - next; - } - s|(.*)[0-9#\-_!/]|$1| and next; - - # inspired by "Christian Brolin" "Long names are doom" on comp.lang.functional - s|(.+)[AEIOU]|$1| and next; # allButFirstVowels - s|(.*)(.)\2|$1$2| and next; # 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 "can't find a unique name"; - # can't 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('/sbin/pidof smbd >/dev/null') != 0 || - system('/sbin/pidof nmbd >/dev/null') != 0) { - # trying to start the server... - system('/etc/init.d/smb', $_) foreach 'stop', 'start'; - } - exit 0; - } -} |