summaryrefslogtreecommitdiffstats
path: root/perl-install/standalone
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>2002-01-23 01:14:40 +0000
committerPascal Rigaux <pixel@mandriva.com>2002-01-23 01:14:40 +0000
commit2e1f7be41f099e976a9b75a392611ca3b0e4fb9b (patch)
tree50de482ede79a919bf8dbba28ab3b10d495859f6 /perl-install/standalone
parentbca789abe7b38a9d8e410044d09437b711ea96f4 (diff)
downloaddrakx-backup-do-not-use-2e1f7be41f099e976a9b75a392611ca3b0e4fb9b.tar
drakx-backup-do-not-use-2e1f7be41f099e976a9b75a392611ca3b0e4fb9b.tar.gz
drakx-backup-do-not-use-2e1f7be41f099e976a9b75a392611ca3b0e4fb9b.tar.bz2
drakx-backup-do-not-use-2e1f7be41f099e976a9b75a392611ca3b0e4fb9b.tar.xz
drakx-backup-do-not-use-2e1f7be41f099e976a9b75a392611ca3b0e4fb9b.zip
use name mangling for samba labels
Diffstat (limited to 'perl-install/standalone')
-rwxr-xr-xperl-install/standalone/fileshareset74
1 files changed, 71 insertions, 3 deletions
diff --git a/perl-install/standalone/fileshareset b/perl-install/standalone/fileshareset
index d7fcdfece..81f139ab2 100755
--- a/perl-install/standalone/fileshareset
+++ b/perl-install/standalone/fileshareset
@@ -171,7 +171,8 @@ sub add {
foreach (@$exports) {
$_->{mntpoint} eq $mntpoint and die 'add';
}
- push @$exports, { mntpoint => $mntpoint };
+ push @$exports, my $e = { mntpoint => $mntpoint };
+ $e;
}
sub remove {
@@ -278,8 +279,9 @@ sub read {
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 };
+ push @l, { mntpoint => $mntpoint, raw => $s, label => $label } if $label && $mntpoint;
$s = '';
}
$s .= $_;
@@ -293,8 +295,9 @@ sub write {
if (!exists $_->{raw}) {
$_->{raw} = <<EOF;
-[$_->{mntpoint}]
+[$_->{label}]
path = $_->{mntpoint}
+ comment = $_->{mntpoint}
public = yes
guest ok = yes
writable = no
@@ -306,6 +309,71 @@ EOF
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 > 15) {
+ my ($s) = m|.*?/(.*)|;
+ if (length($s) > 10 && !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") <= 15; $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');