html/cgi-bin/extrahd.cgi

   1 #!/usr/bin/perl
   2 ###############################################################################
   3 #                                                                             #
   4 # IPFire.org - A linux based firewall                                         #
   5 # Copyright (C) 2011  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 # 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.
  74 my $devicefile = "/var/ipfire/extrahd/devices";
  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
  80 &Header::showhttpheaders();
  81
  82 ### Values that have to be initialized
  83 $extrahdsettings{'PATH'} = '';
  84 $extrahdsettings{'FS'} = '';
  85 $extrahdsettings{'DEVICE'} = '';
  86 $extrahdsettings{'ACTION'} = '';
  87 $extrahdsettings{'UUID'} = '';
  88
  89 &Header::getcgihash(\%extrahdsettings);
  90
  91 &Header::openpage('ExtraHD', 1, '');
  92 &Header::openbigbox('100%', 'left', '', $errormessage);
  93
  94 ############################################################################################################################
  95 ############################################################################################################################
  96
  97 #
  98 ## Add a new device.
  99 #
 100 if ($extrahdsettings{'ACTION'} eq $Lang::tr{'add'}) {
 101         # Open device file for reading.
 102         open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
 103         my @devices = <FILE>;
 104         close FILE;
 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" ) {
 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'}.";
 114                 }
 115
 116                 # Check if the uuid is allready used.
 117                 if ("$extrahdsettings{'DEVICE'} eq $uuid") {
 118                         $errormessage = "$extrahdsettings{'DEVICE'} is allready mounted.";
 119                 }
 120         }
 121
 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.
 135                 open(FILE, ">> $devicefile" ) or die "Unable to write $devicefile";
 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'}");
 145         }
 146
 147 #
 148 # Remove an existing one.
 149 #
 150 } elsif ($extrahdsettings{'ACTION'} eq $Lang::tr{'delete'})  {
 151         # Call helper binary to unmount the device.
 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";
 155
 156                 # Read the file content into a temporary array.
 157                 my @tmp = <FILE>;
 158
 159                 # Close file handle.
 160                 close(FILE);
 161
 162                 # Re-open device file for writing.
 163                 open(FILE, "> $devicefile" ) or die "Unable to write $devicefile";
 164
 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 );
 169
 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                         }
 174                 }
 175
 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         }
 181 }
 182
 183 if ($errormessage) {
 184         &Header::openbox('100%', 'left', $Lang::tr{'error messages'});
 185         print "<class name='base'>$errormessage\n";
 186         print "&nbsp;</class>\n";
 187         &Header::closebox();
 188 }
 189
 190 ############################################################################################################################
 191 ############################################################################################################################
 192
 193 &Header::openbox('100%', 'center', $Lang::tr{'extrahd detected drives'});
 194
 195         # Re-read mountpoints.
 196         %mountpoints = &get_mountpoints();
 197
 198         # Read-in the device config file.
 199         open( FILE, "< $devicefile" ) or die "Unable to read $devicefile";
 200
 201         # Loop through the file content.
 202         while (<FILE>) {
 203                 # Cut the line into pieces.
 204                 my ($uuid, $fs, $path) = split( /\;/, $_ );
 205
 206                 # Add the found entry to the hash of configured drives.
 207                 $configured_drives{$uuid} = $path;
 208         }
 209
 210         # Close the file handle.
 211         close(FILE);
 212
 213         print <<END
 214                 <table border='0' width='600' cellspacing="0">
 215 END
 216 ;
 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">&nbsp;</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>&nbsp;</td></tr>
 233                         <tr><td colspan="5">&nbsp;</td></tr>
 234 END
 235 ;
 236
 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
 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.
 265                         if ($mountpoint eq "/" or $mountpoint =~ "^/boot") {
 266                                 $disabled = "disabled";
 267
 268                         # Check if it is mounted.
 269                         } elsif(&is_mounted($mountpoint)) {
 270                                 $disabled = "disabled";
 271
 272                         # Check if the device is used as swap.
 273                         } elsif (&is_swap($partition)) {
 274                                 $disabled = "disabled";
 275                                 $mountpoint = "swap";
 276                         }
 277
 278                         # Omit the used filesystem.
 279                         my $fs = $filesystems{$partition};
 280
 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>
 289 END
 290 ;
 291                                 # Loop through the array of supported filesystems.
 292                                 foreach my $filesystem (@supported_filesystems) {
 293                                         my $selected;
 294
 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>
 306                                 <td align="center">
 307                                         <input type='hidden' name='DEVICE' value='/dev/$partition' />
 308                                         <input type='hidden' name='UUID' value='$uuids{$partition}' />
 309                                         <input type='hidden' name='ACTION' value='$Lang::tr{'add'}' />
 310 END
 311 ;                                       unless($disabled) {
 312                                                 print"<input type='image' alt='$Lang::tr{'add'}' title='$Lang::tr{'add'}' src='/images/add.gif' />\n";
 313                                         }
 314
 315                                 print <<END
 316                                 </form></td></tr>
 317 END
 318 ;               }
 319
 320         }
 321
 322         print <<END
 323         <tr><td align="center" colspan="5">&nbsp;</td></tr>
 324         <tr><td align="center" colspan="5">&nbsp;</td></tr>
 325         <tr><td align="center" colspan="5">$Lang::tr{'extrahd install or load driver'}</td></tr>
 326         </table>
 327 END
 328 ;
 329 &Header::closebox();
 330
 331 &Header::closebigbox();
 332 &Header::closepage();
 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 }