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