[ipfire-2.x.git] / html / cgi-bin / extrahd.cgi

#!/usr/bin/perl
###############################################################################
#                                                                             #
# IPFire.org - A linux based firewall                                         #
# Copyright (C) 2011  IPFire Team  <info@ipfire.org>                          #
#                                                                             #
# 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 3 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 General Public License for more details.                                #
#                                                                             #
# You should have received a copy of the GNU General Public License           #
# along with this program.  If not, see <http://www.gnu.org/licenses/>.       #
#                                                                             #
###############################################################################

use strict;
# enable only the following on debugging purpose
#use warnings;
#use CGI::Carp 'fatalsToBrowser';

require '/var/ipfire/general-functions.pl';
require "${General::swroot}/lang.pl";
require "${General::swroot}/header.pl";

my %extrahdsettings = ();
my $errormessage = "";

# Hash to store the configured drives.
my %configured_drives;

# SYSFS directory which contains all block device data.
my $sysfs_block_dir = "/sys/class/block";

# Array which contains the valid mount directories.
# Only mounting to subdirectories inside them is allowed.
my @valid_mount_dirs = (
	"/data",
	"/media",
	"/mnt",
);

# Array which contains the supported file systems.
my @supported_filesystems = (
	"auto",
	"ext3",
	"ext4",
	"xfs",
	"vfat",
	"ntfs-3g"
);

# Grab all available block devices.
my @devices = &get_block_devices();

# Grab all known UUID's.
my %uuids = &get_uuids();

# Grab all mountpoints.
my %mountpoints = &get_mountpoints();

# Omit the file system types of the mounted devices.
my %filesystems = &get_mountedfs();

# Gather all used swap devices.
my @swaps = &get_swaps();

# The config file which contains the configured devices.
my $devicefile = "/var/ipfire/extrahd/devices";

#workaround to suppress a warning when a variable is used only once
my @dummy = ( ${Header::colourgreen}, ${Header::colourred} );
undef (@dummy);

&Header::showhttpheaders();

### Values that have to be initialized
$extrahdsettings{'PATH'} = '';
$extrahdsettings{'FS'} = '';
$extrahdsettings{'DEVICE'} = '';
$extrahdsettings{'ACTION'} = '';
$extrahdsettings{'UUID'} = '';

&Header::getcgihash(\%extrahdsettings);

&Header::openpage('ExtraHD', 1, '');
&Header::openbigbox('100%', 'left', '', $errormessage);

############################################################################################################################
############################################################################################################################

#
## Add a new device.
#
if ($extrahdsettings{'ACTION'} eq $Lang::tr{'add'}) {
	# Open device file for reading.
	open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
	my @devices = <FILE>;
	close FILE;

	# Loop through the entries line-by-line.
	foreach my $entry (sort @devices) {
		# Split the line into pieces and assign nice variables.
		my ($uuid, $fs, $path) = split( /\;/, $entry );

		# Check if the path is allready used.
		if ( "$extrahdsettings{'PATH'}" eq "$path" ) {
			$errormessage = "$Lang::tr{'extrahd you cant mount'} $extrahdsettings{'DEVICE'} $Lang::tr{'extrahd to'} $extrahdsettings{'PATH'}$Lang::tr{'extrahd because there is already a device mounted'}.";
		}

		# Check if the uuid is allready used.
		if ("$extrahdsettings{'DEVICE'} eq $uuid") {
			$errormessage = "$extrahdsettings{'DEVICE'} is allready mounted.";
		}
	}

	# Check if a valid mount path has been choosen. 
	unless(&is_valid_dir("$extrahdsettings{'PATH'}")) {
		$errormessage = "$Lang::tr{'extrahd you cant mount'} $extrahdsettings{'DEVICE'} $Lang::tr{'extrahd to root'}.";
	}

	# Check if the given path allready is mounted somewhere.
	if(&is_mounted("$extrahdsettings{'PATH'}")) {
		$errormessage = "$Lang::tr{'extrahd you cant mount'} $extrahdsettings{'DEVICE'} $Lang::tr{'extrahd to'} $extrahdsettings{'PATH'}$Lang::tr{'extrahd because there is already a device mounted'}.";
	}

	# Check if there was an error message.
	unless($errormessage) {
		# Re-open the device file for writing.
		open(FILE, ">> $devicefile" ) or die "Unable to write $devicefile";

		# Write the config line.
		print FILE "UUID=$extrahdsettings{'UUID'};$extrahdsettings{'FS'};$extrahdsettings{'PATH'};\n";

		# Close file handle.
		close(FILE);

		# Call helper binary to mount the device.
		&General::system("/usr/local/bin/extrahdctrl", "mount", "$extrahdsettings{'PATH'}");
	}
	
#
# Remove an existing one.
#
} elsif ($extrahdsettings{'ACTION'} eq $Lang::tr{'delete'})  {
	# Call helper binary to unmount the device.
	unless(&General::system("/usr/local/bin/extrahdctrl", "umount", "$extrahdsettings{'PATH'}")) {
		# Open the device file for reading.
		open(FILE, "< $devicefile" ) or die "Unable to read $devicefile";

		# Read the file content into a temporary array.
		my @tmp = <FILE>;

		# Close file handle.
		close(FILE);

		# Re-open device file for writing.
		open(FILE, "> $devicefile" ) or die "Unable to write $devicefile";

		# Loop through the previous read file content.
		foreach my $line (sort @tmp) {
			# Split line content and assign nice variables.
			my ($uuid, $fs, $path) = split( /\;/, $line );

			# Write the line in case it does not contain our element to delete.
			if ($path ne $extrahdsettings{'PATH'}) {
				print FILE "$line";
			}
		}

		# Close file handle.
		close(FILE);
	} else {
		$errormessage = "$Lang::tr{'extrahd cant umount'} $extrahdsettings{'PATH'}$Lang::tr{'extrahd maybe the device is in use'}?";
	}
}

if ($errormessage) {
        &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
        print "<class name='base'>$errormessage\n";
        print "&nbsp;</class>\n";
        &Header::closebox();
}

############################################################################################################################
############################################################################################################################

&Header::openbox('100%', 'center', $Lang::tr{'extrahd detected drives'});

	# Re-read mountpoints.
	%mountpoints = &get_mountpoints();

	# Read-in the device config file.
	open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";

	# Loop through the file content.
	while (<FILE>) {
		# Cut the line into pieces.
		my ($uuid, $fs, $path) = split( /\;/, $_ );

		# Add the found entry to the hash of configured drives.
		$configured_drives{$uuid} = $path;
	}

	# Close the file handle.
	close(FILE);

	print <<END
		<table border='0' width='600' cellspacing="0">
END
;
	foreach my $device (sort @devices) {
		# Grab the device details.
		my $vendor = &get_device_vendor($device);
		my $model = &get_device_model($device);
		my $bsize = &get_device_size($device);

		# Convert size into human-readable format.
		my $size = &General::formatBytes($bsize);

		print <<END
			<tr><td colspan="5">&nbsp;</td></tr>
			<tr><td align='left' colspan="2"><b>/dev/$device</b></td>
			<td align='center' colspan="2">$vendor $model</td>

			<td align='center'>$Lang::tr{'size'} $size</td>
			<td>&nbsp;</td></tr>
			<tr><td colspan="5">&nbsp;</td></tr>
END
;

		# Grab the known partitions of the current block device.
		my @partitions = &get_device_partitions($device);

		foreach my $partition (@partitions) {
			my $disabled;

			# Omit the partition size.
			my $bsize = &get_device_size($partition);

			# Convert into human-readable format.
			my $size = &General::formatBytes($bsize);

			# Get the mountpoint.
			my $mountpoint = $mountpoints{$partition};

			# If no mountpoint could be determined try to grab from
			# configured drives.
			unless($mountpoint) {
				my $uuid = $uuids{$partition};

				# Build uuid string.
				$uuid = "UUID=" . $uuid;

				# Try to obtain a possible moutpoint from configured drives.
				$mountpoint = $configured_drives{$uuid} if ($configured_drives{$uuid});
			}

			# Check if the mountpoint is used as root or boot device.
			if ($mountpoint eq "/" or $mountpoint =~ "^/boot") {
				$disabled = "disabled";

			# Check if it is mounted.
			} elsif(&is_mounted($mountpoint)) {
				$disabled = "disabled";

			# Check if the device is used as swap.
			} elsif (&is_swap($partition)) {
				$disabled = "disabled";
				$mountpoint = "swap";
			}

			# Omit the used filesystem.
			my $fs = $filesystems{$partition};

			print <<END

			<form method='post' action='$ENV{'SCRIPT_NAME'}'>
			<tr><td align="left" colspan=5><strong>UUID=$uuids{$partition}</strong></td></tr>
			<tr>
			<td align="list">/dev/$partition</td>
				<td align="center">$Lang::tr{'size'} $size</td>
				<td align="center"><select name="FS" $disabled>
END
;
				# Loop through the array of supported filesystems.
				foreach my $filesystem (@supported_filesystems) {
					my $selected;

					# Mark the used filesystem as selected.
					if ($filesystem eq $fs) {
						$selected = "selected";
					}

					print "<option value='$filesystem' $selected>$filesystem</option>\n";
				}

			print <<END
					</select></td>
				<td align="center"><input type='text' name='PATH' value=$mountpoint $disabled></td>
				<td align="center">
					<input type='hidden' name='DEVICE' value='/dev/$partition' />
					<input type='hidden' name='UUID' value='$uuids{$partition}' />
					<input type='hidden' name='ACTION' value='$Lang::tr{'add'}' />
END
;					unless($disabled) {
						print"<input type='image' alt='$Lang::tr{'add'}' title='$Lang::tr{'add'}' src='/images/add.gif' />\n";
					}

				print <<END
				</form></td></tr>
END
;		}

	}

	print <<END
	<tr><td align="center" colspan="5">&nbsp;</td></tr>
	<tr><td align="center" colspan="5">&nbsp;</td></tr>
	<tr><td align="center" colspan="5">$Lang::tr{'extrahd install or load driver'}</td></tr>
	</table>
END
;
&Header::closebox();

&Header::closebigbox();
&Header::closepage();

#
## Function which return an array with all available block devices.
#
sub get_block_devices () {
	my @devices;

	# Open directory from kernel sysfs.
	opendir(DEVICES, "/sys/block");

	# Loop through the directory.
	while(readdir(DEVICES)) {
		# Skip . and ..
		next if($_ =~ /^\.$/);
		next if($_ =~ /^\..$/);

		# Skip any loopback and ram devices.
		next if($_ =~ "^loop");
		next if($_ =~ "^ram");

		# Add the device to the array of found devices.
		push(@devices, $_);
	}

	# Close directory handle.
	closedir(DEVICES);

	# Return the devices array.
	return @devices;
}

#
## Function which return all partitions of a given block device.
#
sub get_device_partitions ($) {
	my ($device) = @_;

	# Array to store the known partitions for the given
	# device.
	my @partitions;

	# Assign device directory.
	my $device_dir = "$sysfs_block_dir/$device";

	# Abort and return nothing if the device dir does not exist.
	return unless(-d "$device_dir");

	opendir(DEVICE, "$sysfs_block_dir/$device");
	while(readdir(DEVICE)) {
		next unless($_ =~ "^$device");

		push(@partitions, $_);
	}

	closedir(DEVICE);

	@partitions = sort(@partitions);

	return @partitions;
}

#
## Returns the vendor of a given block device.
#
sub get_device_vendor ($) {
	my ($device) = @_;

	# Assign device directory.
	my $device_dir = "$sysfs_block_dir/$device";

	# Abort and return nothing if the device dir does not exist
	# or no vendor file exists.
	return unless(-d "$device_dir");
	return unless(-f "$device_dir/device/vendor");

	# Open and read-in the device vendor.
	open(VENDOR, "$device_dir/device/vendor");
	my $vendor = <VENDOR>;
	close(VENDOR);

	# Abort and return nothing if no vendor could be read.
	return unless($vendor);

	# Remove any newlines from the vendor string.
	chomp($vendor);

	# Return the omited vendor.
	return $vendor;
}

#
## Returns the model name (string) of a given block device.
#
sub get_device_model ($) {
	my ($device) = @_;

	# Assign device directory.
	my $device_dir = "$sysfs_block_dir/$device";

	# Abort and return nothing if the device dir does not exist
	# or no model file exists.
	return unless(-d "$device_dir");
	return unless(-f "$device_dir/device/model");

	# Open and read-in the device model.
	open(MODEL, "$device_dir/device/model");
	my $model = <MODEL>;
	close(MODEL);

	# Abort and return nothing if no model could be read.
	return unless($model);

	# Remove any newlines from the model string.
	chomp($model);

	# Return the model string.
	return $model;
}

#
## Returns the size of a given device in bytes.
#
sub get_device_size ($) {
	my ($device) = @_;

	# Assign device directory.
	my $device_dir = "$sysfs_block_dir/$device";

	# Abort and return nothing if the device dir does not exist
	# or no size file exists.
	return unless(-d "$device_dir");
	return unless(-f "$device_dir/size");

	# Open and read-in the device size.
	open(SIZE, "$device_dir/size");
	my $size = <SIZE>;
	close(SIZE);

	# Abort and return nothing if the size could not be read.
	return unless($size);

	# Remove any newlines for the size string.
	chomp($size);

	# The omited size only contains the amount of blocks from the
	# given device. To convert this into bytes we have to multiply this
	# value with 512 bytes for each block. This is a static value used by
	# the linux kernel.
	$size = $size * 512;

	# Return the size in bytes.
	return $size;
}

#
## Function which returns all currently mounted devices as a hash.
## example: "sda1" -> "/boot"
#
sub get_mountpoints () {
	my %mounts;

	# Open and read-in the current mounts from the
	# kernel file system.
	open(MOUNT, "/proc/mounts");

	# Loop through the known mounts.
	while(<MOUNT>) {
		# Skip mounts which does not belong to a device.
		next unless ($_ =~ "^/dev");

		# Cut the line into pieces and assign nice variables.
		my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);

		# Split the device name.
		my @tmp = split("/", $dev);

		# Assign the plain device name to a new variable.
		# It is the last element of the array.
		my $device = $tmp[-1];

		# Add the mountpoint to the hash of mountpoints.
		$mounts{"$device"} = $mpoint;
	}

	# Close file handle.
	close(MOUNT);

	# Return the hash of known mountpoints.
	return %mounts;
}

sub get_swaps () {
	my @swaps;

	# Open and read the swaps file.
	open(SWAP, "/proc/swaps");

	# Loop though the file content.
	while(<SWAP>) {
		# Skip lines which does not belong to a device.
		next unless ($_ =~ "^/dev");

		# Split the line and assign nice variables.
		my ($dev, $type, $size, $used, $prio) = split(/ /, $_);

		# Cut the device line into pieces.
		my @tmp = split("/", $dev);

		my $device = @tmp[-1];

		# Add the found swap to the array of swaps.
		push(@swaps, $device);
	}

	# Close file handle.
	close(SWAP);

	# Sort the array.
	@swaps = sort(@swaps);

	# Return the array.
	return @swaps;
}

#
## Function with returns the mounted devices and the used filesystems as a hash.
## Example: "sda1" -> "ext4"
#
sub get_mountedfs () {
	my %mountedfs;

	# Open and read the current mounts from the kernel
	# file system.
	open(MOUNT, "/proc/mounts");

	# Loop through the known mounts.
	while(<MOUNT>) {
		# Skip mounts which does not belong to a device.
		next unless ($_ =~ "^/dev");

		# Split line and assign nice variables.
		my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);

		# Cut the device line into pieces.
		my @tmp = split("/", $dev);

		# Assign the plain device name to a variable
		# It is the last element of the temporary array.
		my $device = $tmp[-1];

		# Convert the filesystem into lower case format.
		$fs = lc($fs);

		# Add the mounted file system.
		$mountedfs{$device} = $fs;
	}

	# Close file handle.
	close(MOUNT);

	# Return the hash with the mounted filesystems.
	return %mountedfs;
}

#
## Function which returns all known UUID's as a hash.
## Example: "sda1" -> "1234-5678-abcd"
#
sub get_uuids () {
	my %uuids;

	# Directory where the uuid mappings can be found.
	my $uuid_dir = "/dev/disk/by-uuid";

	# Open uuid directory and read-in the current known uuids.
	opendir(UUIDS, "$uuid_dir");

	# Loop through the uuids.
	foreach my $uuid (readdir(UUIDS)) {
		# Skip . and ..
		next if($uuid eq "." or $uuid eq "..");

		# Skip everything which is not a symbolic link.
		next unless(-l "$uuid_dir/$uuid");

		# Resolve the target of the symbolic link.
		my $target = readlink("$uuid_dir/$uuid");

		# Split the link target into pieces.
		my @tmp = split("/", $target);

		# Assign the last element of the array to the dev variable.
		my $dev = "$tmp[-1]";

		# Add the device and uuid to the hash of uuids.
		$uuids{$dev} = $uuid;
	}

	# Close directory handle.
	closedir(UUIDS);

	# Return the hash of uuids.
	return %uuids;
}

#
## Returns the device name of a given uuid.
#
sub device_by_uuid ($) {
	my ($uuid) = @_;

	# Reverse the main uuids hash.
	my %uuids = reverse %uuids;

	# Lookup and return the device name.
	return $uuids{$uuid};
}

#
## Returns "True" in case a given path is a known mountpoint.
#
sub is_mounted ($) {
	my ($mpoint) = @_;

	my %mountpoints = reverse %mountpoints;

	# Return "True" if the requested mountpoint is known and
	# therefore mounted.
	return 1 if($mountpoints{$mpoint});
}

#
## Returns "True" if a given mountpoint is a subdirectory of one
## of the directories specified by the valid_mount_dirs array abouve.
#
sub is_valid_dir ($) {
	my ($mpoint) = @_;

	# Split the given mountpoint into pieces and store them
	# in a temporay array.
	my @tmp = split("/", $mpoint);

	# Exit and return nothing if the temporary array is empty.
	return unless(@tmp);

	# Build the root path based on the given mount point.
	my $root_path = "/" . @tmp[1];

	# Check if the root path is valid.
	return 1 if(grep /$root_path/, @valid_mount_dirs);
}

#
# Returns "True" if a device is used as swap.
#
sub is_swap ($) {
	my ($device) = @_;

	return 1 if(grep /$device/, @swaps);
}

#
## Returns "True" if a drive is a configured one.
#
sub is_configured ($) {
	my ($path) = @_;

	# Loop through the hash of configured drives.
	foreach my $uuid (keys %configured_drives) {
	       return 1 if($configured_drives{$uuid} eq "$path");
	}
}
Commit	Line	Data
aa2870e6	1	#!/usr/bin/perl
70df8302 MT	2	###############################################################################
	3	# #
	4	# IPFire.org - A linux based firewall #
20730a6f	5	# Copyright (C) 2011 IPFire Team <info@ipfire.org> #
70df8302 MT	6	# #
	7	# This program is free software: you can redistribute it and/or modify #
	8	# it under the terms of the GNU General Public License as published by #
	9	# the Free Software Foundation, either version 3 of the License, or #
	10	# (at your option) any later version. #
	11	# #
	12	# This program is distributed in the hope that it will be useful, #
	13	# but WITHOUT ANY WARRANTY; without even the implied warranty of #
	14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
	15	# GNU General Public License for more details. #
	16	# #
	17	# You should have received a copy of the GNU General Public License #
	18	# along with this program. If not, see <http://www.gnu.org/licenses/>. #
	19	# #
	20	###############################################################################
aa2870e6 MT	21
	22	use strict;
	23	# enable only the following on debugging purpose
cb5e9c6c CS	24	#use warnings;
cb5e9c6c CS	25	#use CGI::Carp 'fatalsToBrowser';
aa2870e6 MT	26
	27	require '/var/ipfire/general-functions.pl';
	28	require "${General::swroot}/lang.pl";
	29	require "${General::swroot}/header.pl";
	30
	31	my %extrahdsettings = ();
aa2870e6	32	my $errormessage = "";
56ce3e19	33
d0a6f9bd SS	34	# Hash to store the configured drives.
	35	my %configured_drives;
	36
56ce3e19 SS	37	# SYSFS directory which contains all block device data.
	38	my $sysfs_block_dir = "/sys/class/block";
	39
	40	# Array which contains the valid mount directories.
	41	# Only mounting to subdirectories inside them is allowed.
	42	my @valid_mount_dirs = (
	43	"/data",
	44	"/media",
	45	"/mnt",
	46	);
	47
	48	# Array which contains the supported file systems.
	49	my @supported_filesystems = (
	50	"auto",
	51	"ext3",
	52	"ext4",
	53	"xfs",
	54	"vfat",
	55	"ntfs-3g"
	56	);
	57
	58	# Grab all available block devices.
	59	my @devices = &get_block_devices();
	60
	61	# Grab all known UUID's.
	62	my %uuids = &get_uuids();
	63
	64	# Grab all mountpoints.
	65	my %mountpoints = &get_mountpoints();
	66
	67	# Omit the file system types of the mounted devices.
	68	my %filesystems = &get_mountedfs();
	69
	70	# Gather all used swap devices.
	71	my @swaps = &get_swaps();
	72
	73	# The config file which contains the configured devices.
aa2870e6	74	my $devicefile = "/var/ipfire/extrahd/devices";
d5f061e9 MF	75
	76	#workaround to suppress a warning when a variable is used only once
	77	my @dummy = ( ${Header::colourgreen}, ${Header::colourred} );
	78	undef (@dummy);
	79
aa2870e6 MT	80	&Header::showhttpheaders();
	81
	82	### Values that have to be initialized
	83	$extrahdsettings{'PATH'} = '';
	84	$extrahdsettings{'FS'} = '';
	85	$extrahdsettings{'DEVICE'} = '';
	86	$extrahdsettings{'ACTION'} = '';
784d72a2	87	$extrahdsettings{'UUID'} = '';
aa2870e6	88
aa2870e6 MT	89	&Header::getcgihash(\%extrahdsettings);
	90
	91	&Header::openpage('ExtraHD', 1, '');
	92	&Header::openbigbox('100%', 'left', '', $errormessage);
	93
	94	############################################################################################################################
	95	############################################################################################################################
	96
56ce3e19 SS	97	#
	98	## Add a new device.
	99	#
	100	if ($extrahdsettings{'ACTION'} eq $Lang::tr{'add'}) {
	101	# Open device file for reading.
aa2870e6	102	open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
56ce3e19	103	my @devices = <FILE>;
aa2870e6	104	close FILE;
56ce3e19 SS	105
	106	# Loop through the entries line-by-line.
	107	foreach my $entry (sort @devices) {
	108	# Split the line into pieces and assign nice variables.
	109	my ($uuid, $fs, $path) = split( /\;/, $entry );
	110
	111	# Check if the path is allready used.
	112	if ( "$extrahdsettings{'PATH'}" eq "$path" ) {
20730a6f	113	$errormessage = "$Lang::tr{'extrahd you cant mount'} $extrahdsettings{'DEVICE'} $Lang::tr{'extrahd to'} $extrahdsettings{'PATH'}$Lang::tr{'extrahd because there is already a device mounted'}.";
aa2870e6	114	}
56ce3e19 SS	115
	116	# Check if the uuid is allready used.
	117	if ("$extrahdsettings{'DEVICE'} eq $uuid") {
	118	$errormessage = "$extrahdsettings{'DEVICE'} is allready mounted.";
aa2870e6 MT	119	}
	120	}
	121
56ce3e19 SS	122	# Check if a valid mount path has been choosen.
	123	unless(&is_valid_dir("$extrahdsettings{'PATH'}")) {
	124	$errormessage = "$Lang::tr{'extrahd you cant mount'} $extrahdsettings{'DEVICE'} $Lang::tr{'extrahd to root'}.";
	125	}
	126
	127	# Check if the given path allready is mounted somewhere.
	128	if(&is_mounted("$extrahdsettings{'PATH'}")) {
	129	$errormessage = "$Lang::tr{'extrahd you cant mount'} $extrahdsettings{'DEVICE'} $Lang::tr{'extrahd to'} $extrahdsettings{'PATH'}$Lang::tr{'extrahd because there is already a device mounted'}.";
	130	}
	131
	132	# Check if there was an error message.
	133	unless($errormessage) {
	134	# Re-open the device file for writing.
aa2870e6	135	open(FILE, ">> $devicefile" ) or die "Unable to write $devicefile";
56ce3e19 SS	136
	137	# Write the config line.
	138	print FILE "UUID=$extrahdsettings{'UUID'};$extrahdsettings{'FS'};$extrahdsettings{'PATH'};\n";
	139
	140	# Close file handle.
	141	close(FILE);
	142
	143	# Call helper binary to mount the device.
	144	&General::system("/usr/local/bin/extrahdctrl", "mount", "$extrahdsettings{'PATH'}");
aa2870e6	145	}
56ce3e19 SS	146
	147	#
	148	# Remove an existing one.
	149	#
	150	} elsif ($extrahdsettings{'ACTION'} eq $Lang::tr{'delete'}) {
	151	# Call helper binary to unmount the device.
94aeac8a SS	152	unless(&General::system("/usr/local/bin/extrahdctrl", "umount", "$extrahdsettings{'PATH'}")) {
	153	# Open the device file for reading.
	154	open(FILE, "< $devicefile" ) or die "Unable to read $devicefile";
56ce3e19	155
94aeac8a SS	156	# Read the file content into a temporary array.
94aeac8a SS	157	my @tmp = <FILE>;
56ce3e19	158
94aeac8a SS	159	# Close file handle.
94aeac8a SS	160	close(FILE);
56ce3e19	161
94aeac8a SS	162	# Re-open device file for writing.
94aeac8a SS	163	open(FILE, "> $devicefile" ) or die "Unable to write $devicefile";
56ce3e19	164
94aeac8a SS	165	# Loop through the previous read file content.
	166	foreach my $line (sort @tmp) {
	167	# Split line content and assign nice variables.
	168	my ($uuid, $fs, $path) = split( /\;/, $line );
56ce3e19	169
94aeac8a SS	170	# Write the line in case it does not contain our element to delete.
	171	if ($path ne $extrahdsettings{'PATH'}) {
	172	print FILE "$line";
	173	}
aa2870e6	174	}
56ce3e19	175
94aeac8a SS	176	# Close file handle.
	177	close(FILE);
	178	} else {
	179	$errormessage = "$Lang::tr{'extrahd cant umount'} $extrahdsettings{'PATH'}$Lang::tr{'extrahd maybe the device is in use'}?";
	180	}
aa2870e6 MT	181	}
	182
	183	if ($errormessage) {
	184	&Header::openbox('100%', 'left', $Lang::tr{'error messages'});
	185	print "<class name='base'>$errormessage\n";
	186	print " </class>\n";
	187	&Header::closebox();
	188	}
	189
	190	############################################################################################################################
	191	############################################################################################################################
	192
d0a6f9bd SS	193	&Header::openbox('100%', 'center', $Lang::tr{'extrahd detected drives'});
d0a6f9bd SS	194
56ce3e19 SS	195	# Re-read mountpoints.
56ce3e19 SS	196	%mountpoints = &get_mountpoints();
3a69c4fb	197
56ce3e19 SS	198	# Read-in the device config file.
56ce3e19 SS	199	open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
56ce3e19 SS	200
56ce3e19 SS	201	# Loop through the file content.
d0a6f9bd SS	202	while (<FILE>) {
	203	# Cut the line into pieces.
	204	my ($uuid, $fs, $path) = split( /\;/, $_ );
56ce3e19	205
d0a6f9bd SS	206	# Add the found entry to the hash of configured drives.
d0a6f9bd SS	207	$configured_drives{$uuid} = $path;
aa2870e6	208	}
56ce3e19	209
d0a6f9bd SS	210	# Close the file handle.
	211	close(FILE);
	212
aa2870e6 MT	213	print <<END
	214	<table border='0' width='600' cellspacing="0">
	215	END
	216	;
56ce3e19 SS	217	foreach my $device (sort @devices) {
	218	# Grab the device details.
	219	my $vendor = &get_device_vendor($device);
	220	my $model = &get_device_model($device);
	221	my $bsize = &get_device_size($device);
	222
	223	# Convert size into human-readable format.
	224	my $size = &General::formatBytes($bsize);
	225
	226	print <<END
	227	<tr><td colspan="5"> </td></tr>
	228	<tr><td align='left' colspan="2"><b>/dev/$device</b></td>
	229	<td align='center' colspan="2">$vendor $model</td>
	230
	231	<td align='center'>$Lang::tr{'size'} $size</td>
	232	<td> </td></tr>
	233	<tr><td colspan="5"> </td></tr>
aa2870e6 MT	234	END
aa2870e6 MT	235	;
20730a6f	236
56ce3e19 SS	237	# Grab the known partitions of the current block device.
	238	my @partitions = &get_device_partitions($device);
	239
	240	foreach my $partition (@partitions) {
	241	my $disabled;
	242
	243	# Omit the partition size.
	244	my $bsize = &get_device_size($partition);
	245
	246	# Convert into human-readable format.
	247	my $size = &General::formatBytes($bsize);
	248
	249	# Get the mountpoint.
	250	my $mountpoint = $mountpoints{$partition};
	251
d0a6f9bd SS	252	# If no mountpoint could be determined try to grab from
	253	# configured drives.
	254	unless($mountpoint) {
	255	my $uuid = $uuids{$partition};
	256
	257	# Build uuid string.
	258	$uuid = "UUID=" . $uuid;
	259
	260	# Try to obtain a possible moutpoint from configured drives.
	261	$mountpoint = $configured_drives{$uuid} if ($configured_drives{$uuid});
	262	}
	263
	264	# Check if the mountpoint is used as root or boot device.
56ce3e19 SS	265	if ($mountpoint eq "/" or $mountpoint =~ "^/boot") {
56ce3e19 SS	266	$disabled = "disabled";
d0a6f9bd SS	267
d0a6f9bd SS	268	# Check if it is mounted.
56ce3e19 SS	269	} elsif(&is_mounted($mountpoint)) {
56ce3e19 SS	270	$disabled = "disabled";
56ce3e19 SS	271
56ce3e19 SS	272	# Check if the device is used as swap.
d0a6f9bd	273	} elsif (&is_swap($partition)) {
56ce3e19 SS	274	$disabled = "disabled";
	275	$mountpoint = "swap";
	276	}
	277
d0a6f9bd SS	278	# Omit the used filesystem.
	279	my $fs = $filesystems{$partition};
	280
56ce3e19 SS	281	print <<END
	282
	283	<form method='post' action='$ENV{'SCRIPT_NAME'}'>
	284	<tr><td align="left" colspan=5><strong>UUID=$uuids{$partition}</strong></td></tr>
	285	<tr>
	286	<td align="list">/dev/$partition</td>
	287	<td align="center">$Lang::tr{'size'} $size</td>
	288	<td align="center"><select name="FS" $disabled>
aa2870e6 MT	289	END
aa2870e6 MT	290	;
56ce3e19 SS	291	# Loop through the array of supported filesystems.
	292	foreach my $filesystem (@supported_filesystems) {
	293	my $selected;
aa2870e6	294
56ce3e19 SS	295	# Mark the used filesystem as selected.
	296	if ($filesystem eq $fs) {
	297	$selected = "selected";
	298	}
	299
	300	print "<option value='$filesystem' $selected>$filesystem</option>\n";
	301	}
	302
	303	print <<END
	304	</select></td>
	305	<td align="center"><input type='text' name='PATH' value=$mountpoint $disabled></td>
aa2870e6	306	<td align="center">
56ce3e19 SS	307	<input type='hidden' name='DEVICE' value='/dev/$partition' />
56ce3e19 SS	308	<input type='hidden' name='UUID' value='$uuids{$partition}' />
1d55fccd	309	<input type='hidden' name='ACTION' value='$Lang::tr{'add'}' />
20730a6f	310	END
56ce3e19 SS	311	; unless($disabled) {
	312	print"<input type='image' alt='$Lang::tr{'add'}' title='$Lang::tr{'add'}' src='/images/add.gif' />\n";
	313	}
aa2870e6	314
56ce3e19 SS	315	print <<END
56ce3e19 SS	316	</form></td></tr>
aa2870e6	317	END
56ce3e19 SS	318	; }
56ce3e19 SS	319
aa2870e6 MT	320	}
	321
	322	print <<END
20730a6f JPT	323	<tr><td align="center" colspan="5"> </td></tr>
	324	<tr><td align="center" colspan="5"> </td></tr>
	325	<tr><td align="center" colspan="5">$Lang::tr{'extrahd install or load driver'}</td></tr>
aa2870e6 MT	326	</table>
	327	END
	328	;
	329	&Header::closebox();
	330
	331	&Header::closebigbox();
	332	&Header::closepage();
a2c88aad SS	333
	334	#
	335	## Function which return an array with all available block devices.
	336	#
	337	sub get_block_devices () {
	338	my @devices;
	339
	340	# Open directory from kernel sysfs.
	341	opendir(DEVICES, "/sys/block");
	342
	343	# Loop through the directory.
	344	while(readdir(DEVICES)) {
	345	# Skip . and ..
	346	next if($_ =~ /^\.$/);
	347	next if($_ =~ /^\..$/);
	348
	349	# Skip any loopback and ram devices.
	350	next if($_ =~ "^loop");
	351	next if($_ =~ "^ram");
	352
	353	# Add the device to the array of found devices.
	354	push(@devices, $_);
	355	}
	356
	357	# Close directory handle.
	358	closedir(DEVICES);
	359
	360	# Return the devices array.
	361	return @devices;
	362	}
	363
	364	#
	365	## Function which return all partitions of a given block device.
	366	#
	367	sub get_device_partitions ($) {
	368	my ($device) = @_;
	369
	370	# Array to store the known partitions for the given
	371	# device.
	372	my @partitions;
	373
	374	# Assign device directory.
	375	my $device_dir = "$sysfs_block_dir/$device";
	376
	377	# Abort and return nothing if the device dir does not exist.
	378	return unless(-d "$device_dir");
	379
	380	opendir(DEVICE, "$sysfs_block_dir/$device");
	381	while(readdir(DEVICE)) {
	382	next unless($_ =~ "^$device");
	383
	384	push(@partitions, $_);
	385	}
	386
	387	closedir(DEVICE);
	388
	389	@partitions = sort(@partitions);
	390
	391	return @partitions;
	392	}
	393
	394	#
	395	## Returns the vendor of a given block device.
	396	#
397	sub get_device_vendor ($) {
398	my ($device) = @_;
399
400	# Assign device directory.
401	my $device_dir = "$sysfs_block_dir/$device";
402
403	# Abort and return nothing if the device dir does not exist
404	# or no vendor file exists.
405	return unless(-d "$device_dir");
406	return unless(-f "$device_dir/device/vendor");
407
408	# Open and read-in the device vendor.
409	open(VENDOR, "$device_dir/device/vendor");
410	my $vendor = <VENDOR>;
411	close(VENDOR);
412
413	# Abort and return nothing if no vendor could be read.
414	return unless($vendor);
415
416	# Remove any newlines from the vendor string.
417	chomp($vendor);
418
419	# Return the omited vendor.
420	return $vendor;
421	}
422
423	#
424	## Returns the model name (string) of a given block device.
425	#
426	sub get_device_model ($) {
427	my ($device) = @_;
428
429	# Assign device directory.
430	my $device_dir = "$sysfs_block_dir/$device";
431
432	# Abort and return nothing if the device dir does not exist
433	# or no model file exists.
434	return unless(-d "$device_dir");
435	return unless(-f "$device_dir/device/model");
436
437	# Open and read-in the device model.
438	open(MODEL, "$device_dir/device/model");
439	my $model = <MODEL>;
440	close(MODEL);
441
442	# Abort and return nothing if no model could be read.
443	return unless($model);
444
445	# Remove any newlines from the model string.
446	chomp($model);
447
448	# Return the model string.
449	return $model;
450	}
451
452	#
453	## Returns the size of a given device in bytes.
454	#
455	sub get_device_size ($) {
456	my ($device) = @_;
457
458	# Assign device directory.
459	my $device_dir = "$sysfs_block_dir/$device";
460
461	# Abort and return nothing if the device dir does not exist
462	# or no size file exists.
463	return unless(-d "$device_dir");
464	return unless(-f "$device_dir/size");
465
466	# Open and read-in the device size.
467	open(SIZE, "$device_dir/size");
468	my $size = <SIZE>;
469	close(SIZE);
470
471	# Abort and return nothing if the size could not be read.
472	return unless($size);
473
474	# Remove any newlines for the size string.
475	chomp($size);
476
477	# The omited size only contains the amount of blocks from the
478	# given device. To convert this into bytes we have to multiply this
479	# value with 512 bytes for each block. This is a static value used by
480	# the linux kernel.
481	$size = $size * 512;
482
483	# Return the size in bytes.
484	return $size;
485	}
486
487	#
488	## Function which returns all currently mounted devices as a hash.
489	## example: "sda1" -> "/boot"
490	#
491	sub get_mountpoints () {
492	my %mounts;
493
494	# Open and read-in the current mounts from the
495	# kernel file system.
496	open(MOUNT, "/proc/mounts");
497
498	# Loop through the known mounts.
499	while(<MOUNT>) {
500	# Skip mounts which does not belong to a device.
501	next unless ($_ =~ "^/dev");
502
503	# Cut the line into pieces and assign nice variables.
504	my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
505
506	# Split the device name.
507	my @tmp = split("/", $dev);
508
509	# Assign the plain device name to a new variable.
510	# It is the last element of the array.
511	my $device = $tmp[-1];
512
513	# Add the mountpoint to the hash of mountpoints.
514	$mounts{"$device"} = $mpoint;
515	}
516
517	# Close file handle.
518	close(MOUNT);
519
520	# Return the hash of known mountpoints.
521	return %mounts;
522	}
523
524	sub get_swaps () {
525	my @swaps;
526
527	# Open and read the swaps file.
528	open(SWAP, "/proc/swaps");
529
530	# Loop though the file content.
531	while(<SWAP>) {
532	# Skip lines which does not belong to a device.
533	next unless ($_ =~ "^/dev");
534
535	# Split the line and assign nice variables.
536	my ($dev, $type, $size, $used, $prio) = split(/ /, $_);
537
538	# Cut the device line into pieces.
539	my @tmp = split("/", $dev);
540
541	my $device = @tmp[-1];
542
543	# Add the found swap to the array of swaps.
544	push(@swaps, $device);
545	}
546
547	# Close file handle.
548	close(SWAP);
549
550	# Sort the array.
551	@swaps = sort(@swaps);
552
553	# Return the array.
554	return @swaps;
555	}
556
557	#
558	## Function with returns the mounted devices and the used filesystems as a hash.
559	## Example: "sda1" -> "ext4"
560	#
561	sub get_mountedfs () {
562	my %mountedfs;
563
564	# Open and read the current mounts from the kernel
565	# file system.
566	open(MOUNT, "/proc/mounts");
567
568	# Loop through the known mounts.
569	while(<MOUNT>) {
570	# Skip mounts which does not belong to a device.
571	next unless ($_ =~ "^/dev");
572
573	# Split line and assign nice variables.
574	my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
575
576	# Cut the device line into pieces.
577	my @tmp = split("/", $dev);
578
579	# Assign the plain device name to a variable
580	# It is the last element of the temporary array.
581	my $device = $tmp[-1];
582
583	# Convert the filesystem into lower case format.
584	$fs = lc($fs);
585
586	# Add the mounted file system.
587	$mountedfs{$device} = $fs;
588	}
589
590	# Close file handle.
591	close(MOUNT);
592
593	# Return the hash with the mounted filesystems.
594	return %mountedfs;
595	}
596
597	#
598	## Function which returns all known UUID's as a hash.
599	## Example: "sda1" -> "1234-5678-abcd"
600	#
601	sub get_uuids () {
602	my %uuids;
603
604	# Directory where the uuid mappings can be found.
605	my $uuid_dir = "/dev/disk/by-uuid";
606
607	# Open uuid directory and read-in the current known uuids.
608	opendir(UUIDS, "$uuid_dir");
609
610	# Loop through the uuids.
611	foreach my $uuid (readdir(UUIDS)) {
612	# Skip . and ..
613	next if($uuid eq "." or $uuid eq "..");
614
615	# Skip everything which is not a symbolic link.
616	next unless(-l "$uuid_dir/$uuid");
617
618	# Resolve the target of the symbolic link.
619	my $target = readlink("$uuid_dir/$uuid");
620
621	# Split the link target into pieces.
622	my @tmp = split("/", $target);
623
624	# Assign the last element of the array to the dev variable.
625	my $dev = "$tmp[-1]";
626
627	# Add the device and uuid to the hash of uuids.
628	$uuids{$dev} = $uuid;
629	}
630
631	# Close directory handle.
632	closedir(UUIDS);
633
634	# Return the hash of uuids.
635	return %uuids;
636	}
637
638	#
639	## Returns the device name of a given uuid.
640	#
641	sub device_by_uuid ($) {
642	my ($uuid) = @_;
643
644	# Reverse the main uuids hash.
645	my %uuids = reverse %uuids;
646
647	# Lookup and return the device name.
648	return $uuids{$uuid};
649	}
650
651	#
652	## Returns "True" in case a given path is a known mountpoint.
653	#
654	sub is_mounted ($) {
655	my ($mpoint) = @_;
656
657	my %mountpoints = reverse %mountpoints;
658
659	# Return "True" if the requested mountpoint is known and
660	# therefore mounted.
661	return 1 if($mountpoints{$mpoint});
662	}
663
664	#
665	## Returns "True" if a given mountpoint is a subdirectory of one
666	## of the directories specified by the valid_mount_dirs array abouve.
667	#
668	sub is_valid_dir ($) {
669	my ($mpoint) = @_;
670
671	# Split the given mountpoint into pieces and store them
672	# in a temporay array.
673	my @tmp = split("/", $mpoint);
674
675	# Exit and return nothing if the temporary array is empty.
676	return unless(@tmp);
677
678	# Build the root path based on the given mount point.
679	my $root_path = "/" . @tmp[1];
680
681	# Check if the root path is valid.
682	return 1 if(grep /$root_path/, @valid_mount_dirs);
683	}
684
685	#
686	# Returns "True" if a device is used as swap.
687	#
688	sub is_swap ($) {
689	my ($device) = @_;
690
691	return 1 if(grep /$device/, @swaps);
692	}
0aa77c2f SS	693
	694	#
	695	## Returns "True" if a drive is a configured one.
	696	#
	697	sub is_configured ($) {
	698	my ($path) = @_;
	699
	700	# Loop through the hash of configured drives.
	701	foreach my $uuid (keys %configured_drives) {
	702	return 1 if($configured_drives{$uuid} eq "$path");
	703	}
	704	}