#!/usr/bin/env perl #-*- Mode: perl; tab-width: 2; indent-tabs-mode: nil; c-basic-offset: 2 -*- # Working with filesystems, both local and networked. # # Copyright (C) 2000-2001 Ximian, Inc. # # Authors: Hans Petter Jansson # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU Library General Public License as published # by the Free Software Foundation; either version 2 of the License, 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 Library General Public License for more details. # # You should have received a copy of the GNU Library 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. $SCRIPTSDIR = "@scriptsdir@"; if ($SCRIPTSDIR =~ /^@scriptsdir[@]/) { $SCRIPTSDIR = "."; $DOTIN = ".in"; } require "$SCRIPTSDIR/file.pl$DOTIN"; require "$SCRIPTSDIR/parse.pl$DOTIN"; require "$SCRIPTSDIR/xml.pl$DOTIN"; # --- Utilities --- # # Merge items in hash B missing in A into A. sub merge_hashes { my ($ha, $hb) = @_; my $key; foreach $key (keys %$hb) { $$ha{$key} = $$hb{$key} if !exists $$ha{$key}; } } sub gst_filesys_ext2_device_to_label # device { my ($device) = @_; my $label; my $fd; $fd = &gst_file_run_pipe_read ("e2label $device"); return undef if $fd eq undef; $label = <$fd>; chomp $label; &gst_file_close ($fd); return $label; } # --- filesys_info; information on a particular filesystem --- # sub gst_filesys_info_new { my $info = {}; my $opthash = {}; $$info{'options'} = $opthash; return ($info); } # Make a deep copy of a filesys_info struct. # # Returns a newly allocated filesys_info, identical to the argument. sub gst_filesys_info_dup # filesys_info { my $orig = $_[0]; my $dup; my $options = $$orig{'options'}; $dup = { %$orig }; $$dup{'options'} = { %$options }; return $dup; } sub gst_filesys_info_match # filesys_info, device, label, uuid, network_host, network_path { my ($info, $device, $label, $uuid, $network_host, $network_path, $point) = @_; if (($label && $info->{'label'} eq $label) || ($uuid && $info->{'uuid'} eq $uuid) || ($network_host && $network_path && $info->{'network_host'} eq $network_host && $info->{'network_path'} eq $network_path) || ($device && $device ne "none" && $info->{'device'} eq $device) || ($device eq "none" && $info->{'device'} eq "none" && $point eq $info->{'point'})) { return 1; } return 0; } sub gst_filesys_info_settings_to_options { my ($info) = @_; if (&gst_filesys_info_get_mounted ($info)) { &gst_filesys_info_remove_option ($info, "noauto"); } else { &gst_filesys_info_set_option ($info, "noauto", ""); } } sub gst_filesys_info_match_options # filesys_info, filesys_info { my ($info_a, $info_b) = @_; if (&gst_filesys_info_print_options ($info_a) eq &gst_filesys_info_print_options ($info_b)) { return 1; } return 0; } sub gst_filesys_info_match_data # filesys_info, filesys_info { my ($info_a, $info_b) = @_; if (&gst_filesys_info_get_point ($info_a) eq &gst_filesys_info_get_point ($info_b) && &gst_filesys_info_get_fs ($info_a) eq &gst_filesys_info_get_fs ($info_b) && &gst_filesys_info_get_dump ($info_a) eq &gst_filesys_info_get_dump ($info_b) && &gst_filesys_info_get_priority ($info_a) eq &gst_filesys_info_get_priority ($info_b) && &gst_filesys_info_match_options ($info_a, $info_b)) { return 1; } return 0; } # Merge options in B missing in A into A. sub gst_filesys_info_merge_options { my ($info_a, $info_b) = @_; my ($opt_a, $opt_b, $key); $opt_a = $$info_a{'options'}; $opt_b = $$info_b{'options'}; &merge_hashes ($opt_a, $opt_b); } # Merge stuff in B missing in A into A. sub gst_filesys_info_merge { my ($info_a, $info_b) = @_; my $key; &merge_hashes ($info_a, $info_b); &gst_filesys_info_merge_options ($info_a, $info_b); } # Generic set function for filesys_info properties. We need this to # delete keys if they don't have meaningful values, otherwise an empty # value could override a perfectly good value in a merge. sub gst_filesys_info_set # filesys_info, key, value { my ($filesys_info, $key, $value) = @_; if ($value eq "") { delete $filesys_info->{$key}; } else { $filesys_info->{$key} = $value; } } sub gst_filesys_info_get_device # filesys_info { return $_[0]->{'device'}; } sub gst_filesys_info_set_device # filesys_info, device { &gst_filesys_info_set ($_[0], 'device', $_[1]); } sub gst_filesys_info_get_label # filesys_info { return $_[0]->{'label'}; } sub gst_filesys_info_set_label # filesys_info, label { &gst_filesys_info_set ($_[0], 'label', $_[1]); } sub gst_filesys_info_get_network_host # filesys_info { return $_[0]->{'network_host'}; } sub gst_filesys_info_set_network_host # filesys_info, network_host { my ($info, $host) = @_; $host =~ s/^\/+//; &gst_filesys_info_set ($info, 'network_host', $host); } sub gst_filesys_info_get_network_path # filesys_info { return $_[0]->{'network_path'}; } sub gst_filesys_info_set_network_path # filesys_info, network_path { my ($info, $path) = @_; $path = "/" . $path if (!($path =~ /^\//)); &gst_filesys_info_set ($info, 'network_path', $path); } sub gst_filesys_info_get_uuid # filesys_info { return $_[0]->{'uuid'}; } sub gst_filesys_info_set_uuid # filesys_info, uuid { &gst_filesys_info_set ($_[0], 'uuid', $_[1]); } sub gst_filesys_info_get_point # filesys_info { return $_[0]->{'point'}; } sub gst_filesys_info_set_point # filesys_info, point { &gst_filesys_info_set ($_[0], 'point', $_[1]); } sub gst_filesys_info_get_fs # filesys_info { return $_[0]->{'fs'}; } sub gst_filesys_info_set_fs # filesys_info, fs { &gst_filesys_info_set ($_[0], 'fs', $_[1]); } sub gst_filesys_info_get_dump # filesys_info { return $_[0]->{'dump'} || "0"; } sub gst_filesys_info_set_dump # filesys_info, dump { &gst_filesys_info_set ($_[0], 'dump', $_[1]); } sub gst_filesys_info_get_priority # filesys_info { return $_[0]->{'priority'} || "0"; } sub gst_filesys_info_set_priority # filesys_info, priority { &gst_filesys_info_set ($_[0], 'priority', $_[1]); } sub gst_filesys_info_get_mounted # filesys_info { return $_[0]->{'mounted'}; } sub gst_filesys_info_set_mounted # filesys_info, boolean { &gst_filesys_info_set ($_[0], 'mounted', $_[1]); } sub gst_filesys_info_get_permanent # filesys_info { return $_[0]->{'permanent'}; } sub gst_filesys_info_set_permanent # filesys_info, boolean { &gst_filesys_info_set ($_[0], 'permanent', $_[1]); } sub gst_filesys_info_get_detected # filesys_info { return $_[0]->{'detected'}; } sub gst_filesys_info_set_detected # filesys_info, boolean { &gst_filesys_info_set ($_[0], 'detected', $_[1]); } sub gst_filesys_info_get_option # filesys_info, option { return $_[0]->{'options'}{$_[1]}; } # We can't delete keys with no values here, since most fs options don't # have values (i.e. they key's presence constitutes a boolean). A value of # " " (one space) indicates that this entry takes a value (is non-bool), but # has none. sub gst_filesys_info_set_option # filesys_info, option, value { $_[0]->{'options'}{$_[1]} = $_[2]; } sub gst_filesys_info_remove_option # filesys_info, option { delete $_[0]->{'options'}{$_[1]}; } # --- filesys_table; multiple instances of filesys_info --- # sub gst_filesys_table_new { my @array; return \@array; } # Make a deep copy of a filesys_table struct. # # Returns a newly allocated filesys_table, identical to the argument. sub gst_filesys_table_dup # filesys_table { my $orig = $_[0]; my $dup = &gst_filesys_table_new (); my $i; foreach $i (@$orig) { &gst_filesys_table_add ($dup, &gst_filesys_info_dup ($i)); } return $dup; } # Add a filesys_info reference to a filesys_table. Note: This function # does not check for uniqueness, which lets you add several references # to the same filesys_info. sub gst_filesys_table_add # filesys_table, filesys_info { my ($table, $info) = @_; push @$table, $info; } # Ensure that a filesys_info reference exists in a filesys_table. If it # doesn't, it will be added. If it does, no action will be taken. sub gst_filesys_table_ensure # filesys_table, filesys_info { my ($table, $info) = @_; my $i; foreach $i (@$table) { return if ($i eq $info); } &gst_filesys_table_add ($table, $info); } # Remove a filesys_info reference from a filesys_table. sub gst_filesys_table_remove # filesys_table, filesys_info { my ($table, $info) = @_; my $i; if ($info == undef) { return; } for ($i = 0; $i < @$table; $i++) { if (@$table [$i] eq $info) { @$table = (@$table [0 .. $i - 1], @$table [$i + 1 .. @$table - 1]); return; } } &gst_debug_print_line ("Entry to remove [" . $info . "] not found in filesys_table."); } # Find and return a reference to a filesys_info in a filesys_table # matching any of the information provided. sub gst_filesys_table_find # filesys_table, device, label, uuid, network_host, network_path { my ($table, $device, $label, $uuid, $network_host, $network_path, $point) = @_; my $i; # Match on high-quality keys. foreach $i (@$table) { if (($label && $i->{'label'} eq $label) || ($uuid && $i->{'uuid'} eq $uuid) || ($network_host && $network_path && $i->{'network_host'} eq $network_host && $i->{'network_path'} eq $network_path)) { return $i; } } # Match on low-quality keys. if ($device) { foreach $i (@$table) { if (($device && $device ne "none" && $i->{'device'} eq $device) || ($device eq "none" && $i->{'device'} eq "none" && $point eq $i->{'point'})) { return $i; } } } &gst_debug_print_line ("Entry [" . $device . "] not found in filesys_table."); return undef; } sub gst_filesys_table_find_info_equivalent # filesys_table, filesys_info { my ($table, $info) = @_; return &gst_filesys_table_find ($table, &gst_filesys_info_get_device ($info), &gst_filesys_info_get_label ($info), &gst_filesys_info_get_uuid ($info), &gst_filesys_info_get_network_host ($info), &gst_filesys_info_get_network_path ($info), &gst_filesys_info_get_point ($info)); } # Merges filesys tables A and B, resolving conflicts by giving priority to A. # Any entries in A not in B are preserved. This can also be described as # "salting" one table with another. # # Returns a newly allocated table C, which is a superset of A and B. sub gst_filesys_table_merge_superset # filesys_table A, filesys_table B { my ($intab_a, $intab_b) = @_; my ($hash_c, $hash_b, $key); my $outtab; $outtab = &gst_filesys_table_dup ($intab_a); foreach $info_b (@$intab_b) { my $info_c; if ($info_c = &gst_filesys_table_find_info_equivalent ($outtab, $info_b)) { &gst_filesys_info_merge ($info_c, $info_b); } else { $info_c = &gst_filesys_info_dup ($info_b); &gst_filesys_table_add ($outtab, $info_c); } } return $outtab; } # Merges filesys tables A and B, resolving conflicts by giving priority to A. # Any entries not in A are dropped. # # Returns a newly allocated table C, which is a subset of A and B. sub gst_filesys_table_merge_subset # filesys_table A, filesys_table B { my ($intab_a, $intab_b) = @_; my ($hash_c, $hash_b, $key); my $outtab; $outtab = &gst_filesys_table_dup ($intab_a); foreach $info_b (@$intab_b) { my $info_c; if ($info_c = &gst_filesys_table_find_info_equivalent ($outtab, $info_b)) { &gst_filesys_info_merge ($info_c, $info_b); } } return $outtab; } # Called to indicate that entries in a filesys table are mounted. sub gst_filesys_table_set_mounted_true # filesys_table { my ($table) = @_; foreach $i (@$table) { &gst_filesys_info_set_mounted ($i, 1); } } # Called to indicate that entries in a filesys table are permanent. sub gst_filesys_table_set_permanent_true # filesys_table { my ($table) = @_; foreach $i (@$table) { &gst_filesys_info_set_permanent ($i, 1); } } # Called to indicate that entries in a filesys table have been detected, # e.g. by a network or bus scanner, and were not specified in any part of # the user's configuration. sub gst_filesys_table_set_detected_true # filesys_table { my ($table) = @_; foreach $i (@$table) { &gst_filesys_info_set_detected ($i, 1); } } # --- Parsing --- # sub gst_filesys_entry_identify { my ($device, $fs) = @_; my ($label, $uuid, $network_host, $network_path); # expands to "LABEL=