html/cgi-bin/extrahd.cgi

   1 #!/usr/bin/perl
   2 ###############################################################################
   3 #                                                                             #
   4 # IPFire.org - A linux based firewall                                         #
   5 # Copyright (C) 2023  IPFire Team  <info@ipfire.org>                          #
   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 ###############################################################################
  21
  22 use strict;
  23 # enable only the following on debugging purpose
  24 #use warnings;
  25 #use CGI::Carp 'fatalsToBrowser';
  26
  27 require '/var/ipfire/general-functions.pl';
  28 require "${General::swroot}/lang.pl";
  29 require "${General::swroot}/header.pl";
  30
  31 my %extrahdsettings = ();
  32 my $errormessage = "";
  33
  34 # Hash to store the configured drives.
  35 my %configured_drives;
  36
  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 # Grab all available block devices.
  49 my @devices = &get_block_devices();
  50
  51 # Grab all known UUID's.
  52 my %uuids = &get_uuids();
  53
  54 # Detect device mapper devices.
  55 my %device_mapper = &get_device_mapper();
  56
  57 # Grab members of group devices (RAID, LVM)
  58 my %grouped_devices = &collect_grouped_devices();
  59
  60 # Grab all mountpoints.
  61 my %mountpoints = &get_mountpoints();
  62
  63 # Omit the file system types of the mounted devices.
  64 my %filesystems = &get_mountedfs();
  65
  66 # Gather all used swap devices.
  67 my @swaps = &get_swaps();
  68
  69 # The config file which contains the configured devices.
  70 my $devicefile = "/var/ipfire/extrahd/devices";
  71
  72 #workaround to suppress a warning when a variable is used only once
  73 my @dummy = ( ${Header::colourgreen}, ${Header::colourred} );
  74 undef (@dummy);
  75
  76 &Header::showhttpheaders();
  77
  78 ### Values that have to be initialized
  79 $extrahdsettings{'PATH'} = '';
  80 $extrahdsettings{'FS'} = '';
  81 $extrahdsettings{'DEVICE'} = '';
  82 $extrahdsettings{'ACTION'} = '';
  83 $extrahdsettings{'UUID'} = '';
  84
  85 &Header::getcgihash(\%extrahdsettings);
  86
  87 &Header::openpage('ExtraHD', 1, '');
  88 &Header::openbigbox('100%', 'left', '', $errormessage);
  89
  90 ############################################################################################################################
  91 ############################################################################################################################
  92
  93 #
  94 ## Add a new device.
  95 #
  96 if ($extrahdsettings{'ACTION'} eq $Lang::tr{'add'}) {
  97         # Check if a mount path has been given.
  98         if (not $extrahdsettings{'PATH'}) {
  99                 $errormessage = "$Lang::tr{'extrahd no mount point given'}.";
 100
 101         # Check if a valid mount path has been choosen.
 102         } elsif(not &is_valid_dir("$extrahdsettings{'PATH'}")) {
 103                 $errormessage = "$Lang::tr{'extrahd you cant mount'} $extrahdsettings{'DEVICE'} $Lang::tr{'extrahd to'} $extrahdsettings{'PATH'} $Lang::tr{'extrahd because it is outside the allowed mount path'}.";
 104
 105         # Check if the given path allready is mounted somewhere.
 106         } elsif(&is_mounted("$extrahdsettings{'PATH'}")) {
 107                 $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'}.";
 108         }
 109
 110         # Check against may previously configured drives.
 111         unless ($errormessage) {
 112                 # Open device file for reading.
 113                 open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
 114                 my @devices = <FILE>;
 115                 close FILE;
 116
 117                 # Loop through the entries line-by-line.
 118                 foreach my $entry (sort @devices) {
 119                         # Split the line into pieces and assign nice variables.
 120                         my ($uuid, $fs, $path) = split( /\;/, $entry );
 121
 122                         # Remove tailing UUID= from uuid string.
 123                         $uuid =~ s{^UUID=}{};
 124
 125                         # Check if the path is allready used.
 126                         if ( "$extrahdsettings{'PATH'}" eq "$path" ) {
 127                                 $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'}.";
 128                         }
 129
 130                         # Check if the uuid is allready used.
 131                         if ("$extrahdsettings{'UUID'}" eq "$uuid") {
 132                                 $errormessage = "$extrahdsettings{'DEVICE'} is allready mounted.";
 133                         }
 134                 }
 135         }
 136
 137         # Go further if there was no error message.
 138         unless($errormessage) {
 139                 # Re-open the device file for writing.
 140                 open(FILE, ">> $devicefile" ) or die "Unable to write $devicefile";
 141
 142                 # Write the config line.
 143                 print FILE "UUID=$extrahdsettings{'UUID'};$extrahdsettings{'FS'};$extrahdsettings{'PATH'};\n";
 144
 145                 # Close file handle.
 146                 close(FILE);
 147
 148                 # Call helper binary to mount the device.
 149                 &General::system("/usr/local/bin/extrahdctrl", "mount", "$extrahdsettings{'PATH'}");
 150         }
 151
 152 #
 153 # Remove an existing one.
 154 #
 155 } elsif ($extrahdsettings{'ACTION'} eq $Lang::tr{'delete'})  {
 156         # Call helper binary to unmount the device.
 157         unless(&General::system("/usr/local/bin/extrahdctrl", "umount", "$extrahdsettings{'PATH'}")) {
 158                 # Open the device file for reading.
 159                 open(FILE, "< $devicefile" ) or die "Unable to read $devicefile";
 160
 161                 # Read the file content into a temporary array.
 162                 my @tmp = <FILE>;
 163
 164                 # Close file handle.
 165                 close(FILE);
 166
 167                 # Re-open device file for writing.
 168                 open(FILE, "> $devicefile" ) or die "Unable to write $devicefile";
 169
 170                 # Loop through the previous read file content.
 171                 foreach my $line (sort @tmp) {
 172                         # Split line content and assign nice variables.
 173                         my ($uuid, $fs, $path) = split( /\;/, $line );
 174
 175                         # Write the line in case it does not contain our element to delete.
 176                         if ($path ne $extrahdsettings{'PATH'}) {
 177                                 print FILE "$line";
 178                         }
 179                 }
 180
 181                 # Close file handle.
 182                 close(FILE);
 183         } else {
 184                 $errormessage = "$Lang::tr{'extrahd cant umount'} $extrahdsettings{'PATH'}$Lang::tr{'extrahd maybe the device is in use'}?";
 185         }
 186 }
 187
 188 if ($errormessage) {
 189         &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
 190         print "<class name='base'>$errormessage\n";
 191         print "&nbsp;</class>\n";
 192         &Header::closebox();
 193 }
 194
 195 ############################################################################################################################
 196 ############################################################################################################################
 197
 198 &Header::openbox('100%', 'center', $Lang::tr{'extrahd detected drives'});
 199
 200         # Re-read mountpoints.
 201         %mountpoints = &get_mountpoints();
 202
 203         # Read-in the device config file.
 204         open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
 205
 206         # Loop through the file content.
 207         while (<FILE>) {
 208                 # Cut the line into pieces.
 209                 my ($uuid, $fs, $path) = split( /\;/, $_ );
 210
 211                 # Add the found entry to the hash of configured drives.
 212                 $configured_drives{$uuid} = $path;
 213         }
 214
 215         # Close the file handle.
 216         close(FILE);
 217
 218         print <<END
 219                 <table border='0' width='600' cellspacing="0">
 220 END
 221 ;
 222         foreach my $device (sort @devices) {
 223                 # Grab the device details.
 224                 my $vendor = &get_device_vendor($device);
 225                 my $model = &get_device_model($device);
 226                 my $bsize = &get_device_size($device);
 227
 228                 # Convert size into human-readable format.
 229                 my $size = &General::formatBytes($bsize);
 230
 231                 print <<END
 232                         <tr><td colspan="5">&nbsp;</td></tr>
 233                         <tr><td align='left' colspan="2"><b>/dev/$device</b></td>
 234                         <td align='center' colspan="2">$vendor $model</td>
 235
 236                         <td align='center'>$Lang::tr{'size'} $size</td>
 237                         <td>&nbsp;</td></tr>
 238                         <tr><td colspan="5">&nbsp;</td></tr>
 239 END
 240 ;
 241
 242                 # Grab the known partitions of the current block device.
 243                 my @partitions = &get_device_partitions($device);
 244
 245                 # Check if the block device has any partitions for display.
 246                 if (@partitions) {
 247                         # Loop through the partitions.
 248                         foreach my $partition (@partitions) {
 249                                 # Call function to display the row in the WUI.
 250                                 &print_row($partition);
 251                         }
 252                 }
 253
 254                 # Also print rows for devices with an UUID.
 255                 &print_row($device) if($uuids{$device});
 256         }
 257
 258         print <<END
 259         <tr><td align="center" colspan="5">&nbsp;</td></tr>
 260         <tr><td align="center" colspan="5">&nbsp;</td></tr>
 261         <tr><td align="center" colspan="5">$Lang::tr{'extrahd install or load driver'}</td></tr>
 262         </table>
 263 END
 264 ;
 265
 266 &Header::closebox();
 267
 268 &Header::closebigbox();
 269 &Header::closepage();
 270
 271
 272 #
 273 # Function to print a table row with device data on the WUI.
 274 #
 275 sub print_row ($) {
 276         my ($partition) = @_;
 277
 278         my $disabled;
 279
 280         # Omit the partition size.
 281         my $bsize = &get_device_size($partition);
 282
 283         # Convert into human-readable format.
 284         my $size = &General::formatBytes($bsize);
 285
 286         # Try to omit the used filesystem.
 287         my $fs = $filesystems{$partition};
 288
 289         # Get the mountpoint.
 290         my $mountpoint = $mountpoints{$partition};
 291
 292         # Generate partition string.
 293         my $partition_string = "/dev/$partition";
 294
 295         # Check if the given partition is managed by device mapper.
 296         if (exists($device_mapper{$partition})) {
 297                 # Alter the partition string to used one by the device mapper.
 298                 $partition_string = "$device_mapper{$partition}";
 299         }
 300
 301         # Check if the device is part of a group.
 302         my $grouped_device = &is_grouped_member($partition);
 303
 304         # If no mountpoint could be determined try to grab from
 305         # configured drives.
 306         unless($mountpoint) {
 307                 my $uuid = $uuids{$partition};
 308
 309                 # Build uuid string.
 310                 $uuid = "UUID=" . $uuid;
 311
 312                 # Try to obtain a possible moutpoint from configured drives.
 313                 $mountpoint = $configured_drives{$uuid} if ($configured_drives{$uuid});
 314         }
 315
 316         # Check if the mountpoint is used as root or boot device.
 317         if ($mountpoint eq "/" or $mountpoint =~ "^/boot") {
 318                 $disabled = "disabled";
 319
 320         # Check if it is mounted.
 321         } elsif(&is_mounted($mountpoint)) {
 322                 $disabled = "disabled";
 323
 324         # Check if the device is used as swap.
 325         } elsif (&is_swap($partition)) {
 326                 $disabled = "disabled";
 327                 $mountpoint = "swap";
 328                 $fs = "swap";
 329
 330         # Check if the device is part of a group.
 331         } elsif ($grouped_device) {
 332                 $disabled = "disabled";
 333                 $mountpoint = "/dev/$grouped_device";
 334                 $mountpoint = $device_mapper{$grouped_device} if (exists($device_mapper{$grouped_device}));
 335         }
 336
 337         print "<form method='post' action='$ENV{'SCRIPT_NAME'}'>\n";
 338
 339         # Only display UUID details if an UUID could be obtained.
 340         if ( $uuids{$partition} ) {
 341                 print "<tr><td align='left' colspan=5><strong>UUID=$uuids{$partition}</strong></td></tr>\n";
 342         }
 343
 344         print <<END
 345
 346         <tr>
 347         <td align="list">$partition_string</td>
 348                 <td align="center">$Lang::tr{'size'} $size</td>
 349                 <td align="center">$fs</td>
 350                 <td align="center"><input type='text' name='PATH' value='$mountpoint' $disabled></td>
 351                 <td align="center">
 352                         <input type='hidden' name='DEVICE' value='$partition_string' />
 353                         <input type='hidden' name='UUID' value='$uuids{$partition}' />
 354 END
 355 ;
 356                 # Check if the mountpoint refers to a known configured drive.
 357                 if(&is_configured($mountpoint)) {
 358                         print "<input type='hidden' name='ACTION' value='$Lang::tr{'delete'}'>\n";
 359                         print "<input type='hidden' name='PATH' value='$mountpoint'>\n";
 360
 361                         # Check if the device is mounted properly.
 362                         if(&is_mounted($mountpoint)) {
 363                                 print "<img src='/images/updbooster/updxl-led-green.gif' alt='$Lang::tr{'extrahd mounted'}' title='$Lang::tr{'extrahd mounted'}'>&nbsp;\n";
 364                         } else {
 365                                 print "<img src='/images/updbooster/updxl-led-red.gif' alt='$Lang::tr{'extrahd not mounted'}' title='$Lang::tr{'extrahd not mounted'}'>&nbsp;\n";
 366                         }
 367
 368                                 print "<input type='image' alt='$Lang::tr{'delete'}' title='$Lang::tr{'delete'}' src='/images/delete.gif'>\n";
 369                 } else {
 370                         unless($disabled) {
 371                                 print "<input type='hidden' name='ACTION' value='$Lang::tr{'add'}'>\n";
 372                                 print "<input type='hidden' name='FS' value='auto'>\n";
 373                                 print "<img src='/images/updbooster/updxl-led-gray.gif' alt='$Lang::tr{'extrahd not configured'}' title='$Lang::tr{'extrahd not configured'}'>&nbsp;\n";
 374                                 print "<input type='image' alt='$Lang::tr{'add'}' title='$Lang::tr{'add'}' src='/images/add.gif'>\n";
 375                         }
 376                 }
 377
 378         print <<END
 379         </form></td></tr>
 380 END
 381 ;
 382 }
 383
 384 #
 385 ## Function which return an array with all available block devices.
 386 #
 387 sub get_block_devices () {
 388         my @devices;
 389
 390         # Open directory from kernel sysfs.
 391         opendir(DEVICES, "/sys/block");
 392
 393         # Loop through the directory.
 394         while(readdir(DEVICES)) {
 395                 # Skip . and ..
 396                 next if($_ =~ /^\.$/);
 397                 next if($_ =~ /^\..$/);
 398
 399                 # Skip any loopback and ram devices.
 400                 next if($_ =~ "^loop");
 401                 next if($_ =~ "^ram");
 402
 403                 # Add the device to the array of found devices.
 404                 push(@devices, $_);
 405         }
 406
 407         # Close directory handle.
 408         closedir(DEVICES);
 409
 410         # Return the devices array.
 411         return @devices;
 412 }
 413
 414 #
 415 ## Function which return all partitions of a given block device.
 416 #
 417 sub get_device_partitions ($) {
 418         my ($device) = @_;
 419
 420         # Array to store the known partitions for the given
 421         # device.
 422         my @partitions;
 423
 424         # Assign device directory.
 425         my $device_dir = "$sysfs_block_dir/$device";
 426
 427         # Abort and return nothing if the device dir does not exist.
 428         return unless(-d "$device_dir");
 429
 430         opendir(DEVICE, "$sysfs_block_dir/$device");
 431         while(readdir(DEVICE)) {
 432                 next unless($_ =~ "^$device");
 433
 434                 push(@partitions, $_);
 435         }
 436
 437         closedir(DEVICE);
 438
 439         @partitions = sort(@partitions);
 440
 441         return @partitions;
 442 }
 443
 444 #
 445 ## Returns the vendor of a given block device.
 446 #
 447 sub get_device_vendor ($) {
 448         my ($device) = @_;
 449
 450         # Assign device directory.
 451         my $device_dir = "$sysfs_block_dir/$device";
 452
 453         # Abort and return nothing if the device dir does not exist
 454         # or no vendor file exists.
 455         return unless(-d "$device_dir");
 456         return unless(-f "$device_dir/device/vendor");
 457
 458         # Open and read-in the device vendor.
 459         open(VENDOR, "$device_dir/device/vendor");
 460         my $vendor = <VENDOR>;
 461         close(VENDOR);
 462
 463         # Abort and return nothing if no vendor could be read.
 464         return unless($vendor);
 465
 466         # Remove any newlines from the vendor string.
 467         chomp($vendor);
 468
 469         # Return the omited vendor.
 470         return $vendor;
 471 }
 472
 473 #
 474 ## Returns the model name (string) of a given block device.
 475 #
 476 sub get_device_model ($) {
 477         my ($device) = @_;
 478
 479         # Assign device directory.
 480         my $device_dir = "$sysfs_block_dir/$device";
 481
 482         # Abort and return nothing if the device dir does not exist
 483         # or no model file exists.
 484         return unless(-d "$device_dir");
 485         return unless(-f "$device_dir/device/model");
 486
 487         # Open and read-in the device model.
 488         open(MODEL, "$device_dir/device/model");
 489         my $model = <MODEL>;
 490         close(MODEL);
 491
 492         # Abort and return nothing if no model could be read.
 493         return unless($model);
 494
 495         # Remove any newlines from the model string.
 496         chomp($model);
 497
 498         # Return the model string.
 499         return $model;
 500 }
 501
 502 #
 503 ## Returns the size of a given device in bytes.
 504 #
 505 sub get_device_size ($) {
 506         my ($device) = @_;
 507
 508         # Assign device directory.
 509         my $device_dir = "$sysfs_block_dir/$device";
 510
 511         # Abort and return nothing if the device dir does not exist
 512         # or no size file exists.
 513         return unless(-d "$device_dir");
 514         return unless(-f "$device_dir/size");
 515
 516         # Open and read-in the device size.
 517         open(SIZE, "$device_dir/size");
 518         my $size = <SIZE>;
 519         close(SIZE);
 520
 521         # Abort and return nothing if the size could not be read.
 522         return unless($size);
 523
 524         # Remove any newlines for the size string.
 525         chomp($size);
 526
 527         # The omited size only contains the amount of blocks from the
 528         # given device. To convert this into bytes we have to multiply this
 529         # value with 512 bytes for each block. This is a static value used by
 530         # the linux kernel.
 531         $size = $size * 512;
 532
 533         # Return the size in bytes.
 534         return $size;
 535 }
 536
 537 #
 538 ## Function which tries to detect if a block device is a device mapper device and returns the alias a
 539 ## a hash. Example: "dm-0" -> "/dev/mapper/GROUP-DEVICE"
 540 #
 541 sub get_device_mapper () {
 542         my %mapper_devices = ();
 543
 544         # Loop through all known block devices.
 545         foreach my $block_device (@devices) {
 546                 # Generate  device directory.
 547                 my $device_dir = "$sysfs_block_dir/$block_device";
 548
 549                 # Skip the device if it is not managed by device mapper
 550                 # In this case the "bd" is not present.
 551                 next unless (-e "$device_dir/dm");
 552
 553                 # Grab the group and volume name.
 554                 open(NAME, "$device_dir/dm/name") if (-e "$device_dir/dm/name");
 555                 my $name = <NAME>;
 556                 close(NAME);
 557
 558                 # Skip device if no name could be determined.
 559                 next unless($name);
 560
 561                 # Remove any newlines from the name string.
 562                 chomp($name);
 563
 564                 # Generate path to the dev node in devfs.
 565                 my $dev_path = "/dev/mapper/$name";
 566
 567                 # Store the device and the omited mapper name in the hash.
 568                 $mapper_devices{$block_device} = $dev_path;
 569         }
 570
 571         # Return the hash of omited device mapper devices.
 572         return %mapper_devices;
 573 }
 574
 575 #
 576 ## Function which will collect grouped devices and their members as array in a hash and returns them.
 577 ## For example: "sda1" -> "dm-0" in case /dev/sda1 is assigned to a device mapper group.
 578 #
 579 sub collect_grouped_devices () {
 580         my %grouped_devices = ();
 581
 582         # Loop through the array of known block devices.
 583         foreach my $device (@devices) {
 584                 # Generate device directory.
 585                 my $device_dir = "$sysfs_block_dir/$device";
 586
 587                 # Skip device if it has no members.
 588                 # In this case the "slaves" directory does not exist.
 589                 next unless (-e "$device_dir/slaves");
 590
 591                 # Tempoarary array to store the members of a group.
 592                 my @members = ();
 593
 594                 # Grab all members.
 595                 opendir(MEMBERS, "$device_dir/slaves");
 596                 while(readdir(MEMBERS)) {
 597                         next if($_ eq ".");
 598                         next if($_ eq "..");
 599
 600                         # Add the found member to the array of members.
 601                         push(@members, $_);
 602                 }
 603
 604                 closedir(MEMBERS);
 605
 606                 # Skip the device if no members could be grabbed.
 607                 next unless (@members);
 608
 609                 # Add the array of found members as value to the hash of grouped devices.
 610                 $grouped_devices{$device} = [ @members ];
 611         }
 612
 613         # Return the hash of found grouped devices and their members.
 614         return %grouped_devices;
 615 }
 616
 617 #
 618 ## Function which returns all currently mounted devices as a hash.
 619 ## example: "sda1" -> "/boot"
 620 #
 621 sub get_mountpoints () {
 622         my %mounts;
 623
 624         # Open and read-in the current mounts from the
 625         # kernel file system.
 626         open(MOUNT, "/proc/mounts");
 627
 628         # Loop through the known mounts.
 629         while(<MOUNT>) {
 630                 # Skip mounts which does not belong to a device.
 631                 next unless ($_ =~ "^/dev");
 632
 633                 # Cut the line into pieces and assign nice variables.
 634                 my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
 635
 636                 # Split the device name.
 637                 my @tmp = split("/", $dev);
 638
 639                 # Assign the plain device name to a new variable.
 640                 # It is the last element of the array.
 641                 my $device = $tmp[-1];
 642
 643                 # Add the mountpoint to the hash of mountpoints.
 644                 $mounts{"$device"} = $mpoint;
 645         }
 646
 647         # Close file handle.
 648         close(MOUNT);
 649
 650         # Return the hash of known mountpoints.
 651         return %mounts;
 652 }
 653
 654 sub get_swaps () {
 655         my @swaps;
 656
 657         # Open and read the swaps file.
 658         open(SWAP, "/proc/swaps");
 659
 660         # Loop though the file content.
 661         while(<SWAP>) {
 662                 # Skip lines which does not belong to a device.
 663                 next unless ($_ =~ "^/dev");
 664
 665                 # Split the line and assign nice variables.
 666                 my ($dev, $type, $size, $used, $prio) = split(/ /, $_);
 667
 668                 # Cut the device line into pieces.
 669                 my @tmp = split("/", $dev);
 670
 671                 my $device = @tmp[-1];
 672
 673                 # Add the found swap to the array of swaps.
 674                 push(@swaps, $device);
 675         }
 676
 677         # Close file handle.
 678         close(SWAP);
 679
 680         # Sort the array.
 681         @swaps = sort(@swaps);
 682
 683         # Return the array.
 684         return @swaps;
 685 }
 686
 687 #
 688 ## Function with returns the mounted devices and the used filesystems as a hash.
 689 ## Example: "sda1" -> "ext4"
 690 #
 691 sub get_mountedfs () {
 692         my %mountedfs;
 693
 694         # Open and read the current mounts from the kernel
 695         # file system.
 696         open(MOUNT, "/proc/mounts");
 697
 698         # Loop through the known mounts.
 699         while(<MOUNT>) {
 700                 # Skip mounts which does not belong to a device.
 701                 next unless ($_ =~ "^/dev");
 702
 703                 # Split line and assign nice variables.
 704                 my ($dev, $mpoint, $fs, $options, $a, $b) = split(/ /, $_);
 705
 706                 # Cut the device line into pieces.
 707                 my @tmp = split("/", $dev);
 708
 709                 # Assign the plain device name to a variable
 710                 # It is the last element of the temporary array.
 711                 my $device = $tmp[-1];
 712
 713                 # Convert the filesystem into lower case format.
 714                 $fs = lc($fs);
 715
 716                 # Add the mounted file system.
 717                 $mountedfs{$device} = $fs;
 718         }
 719
 720         # Close file handle.
 721         close(MOUNT);
 722
 723         # Return the hash with the mounted filesystems.
 724         return %mountedfs;
 725 }
 726
 727 #
 728 ## Function which returns all known UUID's as a hash.
 729 ## Example: "sda1" -> "1234-5678-abcd"
 730 #
 731 sub get_uuids () {
 732         my %uuids;
 733
 734         # Directory where the uuid mappings can be found.
 735         my $uuid_dir = "/dev/disk/by-uuid";
 736
 737         # Open uuid directory and read-in the current known uuids.
 738         opendir(UUIDS, "$uuid_dir");
 739
 740         # Loop through the uuids.
 741         foreach my $uuid (readdir(UUIDS)) {
 742                 # Skip . and ..
 743                 next if($uuid eq "." or $uuid eq "..");
 744
 745                 # Skip everything which is not a symbolic link.
 746                 next unless(-l "$uuid_dir/$uuid");
 747
 748                 # Resolve the target of the symbolic link.
 749                 my $target = readlink("$uuid_dir/$uuid");
 750
 751                 # Split the link target into pieces.
 752                 my @tmp = split("/", $target);
 753
 754                 # Assign the last element of the array to the dev variable.
 755                 my $dev = "$tmp[-1]";
 756
 757                 # Add the device and uuid to the hash of uuids.
 758                 $uuids{$dev} = $uuid;
 759         }
 760
 761         # Close directory handle.
 762         closedir(UUIDS);
 763
 764         # Return the hash of uuids.
 765         return %uuids;
 766 }
 767
 768 #
 769 ## Returns the device name of a given uuid.
 770 #
 771 sub device_by_uuid ($) {
 772         my ($uuid) = @_;
 773
 774         # Reverse the main uuids hash.
 775         my %uuids = reverse %uuids;
 776
 777         # Lookup and return the device name.
 778         return $uuids{$uuid};
 779 }
 780
 781 #
 782 ## Returns "True" in case a given path is a known mountpoint.
 783 #
 784 sub is_mounted ($) {
 785         my ($mpoint) = @_;
 786
 787         my %mountpoints = reverse %mountpoints;
 788
 789         # Return "True" if the requested mountpoint is known and
 790         # therefore mounted.
 791         return 1 if($mountpoints{$mpoint});
 792 }
 793
 794 #
 795 ## Returns "True" if a given mountpoint is a subdirectory of one
 796 ## of the directories specified by the valid_mount_dirs array abouve.
 797 #
 798 sub is_valid_dir ($) {
 799         my ($mpoint) = @_;
 800
 801         # Do not allow "/mnt" or "/media" as mount points.
 802         return if($mpoint eq "/mnt");
 803         return if($mpoint eq "/media");
 804
 805         # Split the given mountpoint into pieces and store them
 806         # in a temporay array.
 807         my @tmp = split("/", $mpoint);
 808
 809         # Exit and return nothing if the temporary array is empty.
 810         return unless(@tmp);
 811
 812         # Build the root path based on the given mount point.
 813         my $root_path = "/" . @tmp[1];
 814
 815         # Check if the root path is valid.
 816         return 1 if(grep /$root_path/, @valid_mount_dirs);
 817 }
 818
 819 #
 820 # Returns "True" if a device is used as swap.
 821 #
 822 sub is_swap ($) {
 823         my ($device) = @_;
 824
 825         return 1 if(grep /$device/, @swaps);
 826 }
 827
 828 #
 829 ## Returns "True" if a drive is a configured one.
 830 #
 831 sub is_configured ($) {
 832         my ($path) = @_;
 833
 834         # Loop through the hash of configured drives.
 835         foreach my $uuid (keys %configured_drives) {
 836                return 1 if($configured_drives{$uuid} eq "$path");
 837         }
 838 }
 839
 840 #
 841 ## Retruns the device name of the grouped device,if a given device is a group member.
 842 #
 843 sub is_grouped_member ($) {
 844         my ($device) = @_;
 845
 846         # Loop through the hash of found grouped devices.
 847         foreach my $grouped_device(keys %grouped_devices) {
 848                 # The found members are stored as arrays.
 849                 my @members = @{ $grouped_devices{$grouped_device} };
 850
 851                 # Loop through array of members and check if the given
 852                 # device is part of it.
 853                 foreach my $member (@members) {
 854                         return $grouped_device if ($member eq $device);
 855                 }
 856         }
 857 }