This commit was manufactured by cvs2svn to create tag 'V9_1_38mdk'.V9_1_38mdk

1 files changed, 0 insertions, 389 deletions

diff --git a/perl-install/standalone/fileshareset b/perl-install/standalone/fileshareset
deleted file mode 100755
index 18277d95f..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-2002 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|/../|;
-    $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;
-    }
-}