diff options
Diffstat (limited to 'perl-install/fs/remote')
| -rw-r--r-- | perl-install/fs/remote/davfs.pm | 99 | ||||
| -rw-r--r-- | perl-install/fs/remote/nfs.pm | 46 | ||||
| -rw-r--r-- | perl-install/fs/remote/smb.pm | 13 | 
3 files changed, 132 insertions, 26 deletions
| diff --git a/perl-install/fs/remote/davfs.pm b/perl-install/fs/remote/davfs.pm new file mode 100644 index 000000000..890530cb9 --- /dev/null +++ b/perl-install/fs/remote/davfs.pm @@ -0,0 +1,99 @@ +package fs::remote::davfs; + +use strict; +use diagnostics; + +use common; +use fs::mount_options; + +sub secrets_file() { "$::prefix/etc/davfs2/secrets" } + +sub fstab_entry_to_credentials { +    my ($part) = @_;     + +    my ($options, $unknown) = fs::mount_options::unpack($part); +    my %h = map { $_ => delete $options->{"$_="} } qw(username password); +    foreach (qw(username password)) { +        $h{$_} ||= 'nobody'; +    } +    $h{mntpoint} = $part->{mntpoint} or return; +    fs::mount_options::pack_($part, $options, $unknown), \%h; +} + +sub save_credentials { +    my ($credentials) = @_; +    @$credentials or return; + +    output_with_perm(secrets_file(), 0600,  +		     map { to_double_quoted($_->{mntpoint}, $_->{username}, $_->{password}) . "\n" } @$credentials); +} + +sub mountpoint_credentials_save { +    my ($mntpoint, $mount_opt) = @_; +    my @entries = read_credentials_raw(); +    my $entry = find { $mntpoint eq $_->{mntpoint} } @entries; +    die "mountpoint not found" if !$entry; +    my %h; +    foreach (@$mount_opt) { +        my @var = split(/=/); +        $h{$var[0]} = $var[1]; +    } +    foreach my $key (qw(username password)) { +        $entry->{$key} = $h{$key}; +    } +    save_credentials(\@entries); +} + + +sub read_credentials_raw() { +    from_double_quoted(cat_(secrets_file())); +} + +sub read_credentials { +    my ($mntpoint) = @_; +    find { $mntpoint eq $_->{mntpoint} } read_credentials_raw(); +} + +# Comments are indicated by a '#' character and the rest of the line +# is ignored. Empty lines are ignored too. +# +# Each line consists of two or three items separated by spaces or tabs. +# If an item contains one of the characters space, tab, #, \ or ", this +# character must be escaped by a preceding \. Alternatively, the item +# may be enclosed in double quotes. + +sub from_double_quoted { +    my ($file) = @_; +    my @l; +    my @lines = split("\n",$file); +    foreach (@lines) { +	my ($mnt, $user, $pass, $comment);  +	if (/^\s*(#.*)?$/) { +	    $comment = $1; +	} else { +            if (/^(?:"((?:\\.|[^"])*)"|((?:\\.|[^"\s#])+))\s+(?:"((?:\\.|[^"])*)"|((?:\\.|[^"\s#])+))(?:\s+(?:"((?:\\.|[^"])*)"|((?:\\.|[^"\s#])+)))?(?:\s*|\s*(#.*))?$/) { +	            $mnt = "$1$2"; +		    $mnt =~ s/\\(.)/$1/g; +		    $user = "$3$4"; +	            $user =~ s/\\(.)/$1/g; +		    $pass = "$5$6"; +	            $pass =~ s/\\(.)/$1/g; +		    $comment=$7; +	    } else { +		    die "bad entry $_"; +	    } +        } +        push @l, { 'mntpoint' => $mnt, 'username' => $user, 'password' => $pass, 'comment' => $comment }; +    } +    @l; +} + +sub to_double_quoted { +    my (@l) = @_; +    join(' ', map { +	s/(["\\])/\\$1/g; +	/\s/ ? qq("$_") : $_; +    } @l); +} + +1; diff --git a/perl-install/fs/remote/nfs.pm b/perl-install/fs/remote/nfs.pm index f946a4323..f7a98cb69 100644 --- a/perl-install/fs/remote/nfs.pm +++ b/perl-install/fs/remote/nfs.pm @@ -1,10 +1,11 @@ -package fs::remote::nfs; # $Id$ +package fs::remote::nfs;  use strict;  use diagnostics;  use common;  use fs::remote; +use network::tools;  use log;  our @ISA = 'fs::remote'; @@ -28,31 +29,36 @@ sub to_dev_raw {  sub check {      my ($_class, $in) = @_; -    $in->do_pkgs->ensure_binary_is_installed('nfs-utils-clients', 'showmount') or return; -    system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status') != 0; +    $in->do_pkgs->ensure_files_are_installed([ [ qw(nfs-utils showmount) ] , [ qw(nmap nmap) ] ]); +    require services; +    services::start_not_running_service('rpcbind'); +    services::start('nfs-common'); #- TODO: once nfs-common is fixed, it could use start_not_running_service()      1;  }  sub find_servers { -    open(my $F2, "rpcinfo-flushed -b mountd 2 |"); -    open(my $F3, "rpcinfo-flushed -b mountd 3 |"); - -    common::nonblock($F2); -    common::nonblock($F3); -    my $domain = chomp_(`domainname`); -    my ($s, %servers); -    my $quit; -    while (!$quit) { -	$quit = 1; -	sleep 1; -	while ($s = <$F2> || <$F3>) { -	    $quit = 0; -	    my ($ip, $name) = $s =~ /(\S+)\s+(\S+)/ or log::explanations("bad line in rpcinfo output"), next; -	    $name =~ s/\.$//; -	    $name =~ s/\Q.$domain\E$//; -	    $servers{$ip} ||= { ip => $ip, if_($name ne '(unknown)', name => $name) }; +    my @hosts; +    my %servers; +    my @routes = cat_("/proc/net/route"); +    @routes = reverse(@routes) if common::cmp_kernel_versions(c::kernel_version(), "2.6.39") >= 0; +    foreach (@routes) { +	if (/^(\S+)\s+([0-9A-F]+)\s+([0-9A-F]+)\s+[0-9A-F]+\s+\d+\s+\d+\s+(\d+)\s+([0-9A-F]+)/) { +	    my $net = network::tools::host_hex_to_dotted($2); +	    my $gateway = $3; +	    # get the netmask in binary and remove leading zeros +	    my $mask = unpack('B*', pack('h*', $5)); +	    $mask =~ s/^0*//; +	    push @hosts, $net . "/" . length($mask) if $gateway eq '00000000' && $net ne '169.254.0.0';  	} +     } +    # runs the nmap command on the local subnet +    my $cmd = "/usr/bin/nmap -p 111 --open --system-dns -oG - " . (join ' ',@hosts); +    open my $FH, "$cmd |" or die "Could not perform nmap scan - $!"; +    foreach (<$FH>) {  +      my ($ip, $name) = /^H\S+\s(\S+)\s+\((\S*)\).+Port/ or next; +      $servers{$ip} ||= { ip => $ip, name => $name || $ip };      } +    close $FH;      values %servers;  } diff --git a/perl-install/fs/remote/smb.pm b/perl-install/fs/remote/smb.pm index 933941326..d440fc174 100644 --- a/perl-install/fs/remote/smb.pm +++ b/perl-install/fs/remote/smb.pm @@ -1,11 +1,10 @@ -package fs::remote::smb; # $Id$ +package fs::remote::smb;  use strict;  use diagnostics;  use common;  use fs::mount_options; -use network::network;  use fs::remote; @@ -13,7 +12,7 @@ our @ISA = 'fs::remote';  sub to_fstab_entry {      my ($class, $e) = @_; -    my $part = $class->to_fstab_entry_raw($e, 'smbfs'); +    my $part = $class->to_fstab_entry_raw($e, 'cifs');      if ($e->{server}{username}) {  	my ($options, $unknown) = fs::mount_options::unpack($part);  	$options->{"$_="} = $e->{server}{$_} foreach qw(username password domain); @@ -54,9 +53,11 @@ sub smbclient {  }  sub find_servers { -    my (undef, @l) = `nmblookup "*"`; +    my (undef, @l) = `nmblookup "*"; nmblookup -M -- -`;      s/\s.*\n// foreach @l; +    require network::network;      my @servers = grep { network::network::is_ip($_) } @l; +    return unless @servers;      my %servers;      $servers{$_}{ip} = $_ foreach @servers;      my ($ip, $browse); @@ -124,7 +125,7 @@ sub fstab_entry_to_credentials {      my ($options, $unknown) = fs::mount_options::unpack($part);      $options->{'username='} && $options->{'password='} or return; -    my %h = map { $_ => delete $options->{"$_="} } qw(username domain password); +    my %h = map { $_ => delete $options->{"$_="} } qw(username password);      $h{file} = $options->{'credentials='} = to_credentials($server_name, $h{username});      fs::mount_options::pack_($part, $options, $unknown), \%h;  } @@ -137,7 +138,7 @@ sub remove_bad_credentials {  sub save_credentials {      my ($credentials) = @_;      my $file = $credentials->{file}; -    output_with_perm("$::prefix$file", 0640, map { "$_ = $credentials->{$_}\n" } qw(username domain password)); +    output_with_perm("$::prefix$file", 0640, map { "$_=$credentials->{$_}\n" } qw(username password));  } | 
