git.sur5r.net Git - bacula/rescue/blob - rescue/linux/cdrom/yaird-0.0.5/perl/LabeledPartition.pm

   1 #!perl -w
   2 #
   3 # LabeledPartition -- a partition with ext2 or other label.
   4 #   Copyright (C) 2005  Erik van Konijnenburg
   5 #
   6 #   This program is free software; you can redistribute it and/or modify
   7 #   it under the terms of the GNU General Public License as published by
   8 #   the Free Software Foundation; either version 2 of the License, or
   9 #   (at your option) any later version.
  10 #
  11 #   This program is distributed in the hope that it will be useful,
  12 #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 #   GNU General Public License for more details.
  15 #
  16 #   You should have received a copy of the GNU General Public License
  17 #   along with this program; if not, write to the Free Software
  18 #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  19 #
  20 # descriptors contain:
  21 # - label - string such as volume name for matching in /etc/fstab
  22 # - uuid - similar but hex
  23 # - path - the block special file where the label was found
  24 # - type - what kind of superblock the label was found in.
  25 #
  26 # NOTE: consider delegating this whole mess to findfs from the
  27 # e2fsprogs package.  That package can probe for an extensive
  28 # set of superblocks, knows about LVM, but does not make fs type
  29 # information available via the command line.
  30 #
  31 use strict;
  32 use warnings;
  33 package LabeledPartition;
  34 use base 'Obj';
  35
  36
  37 sub fill {
  38         my $self = shift;
  39         $self->SUPER::fill();
  40         $self->takeArgs ('label', 'uuid', 'path', 'type');
  41 }
  42
  43 sub label       { return $_[0]->{label}; }
  44 sub uuid        { return $_[0]->{uuid}; }
  45 sub type        { return $_[0]->{type}; }
  46 sub path        { return $_[0]->{path}; }
  47
  48 sub string {
  49         my $self = shift;
  50         my $label = ($self->label or '-');
  51         my $uuid = ($self->uuid or '-');
  52         my $type = $self->type;
  53         my $path = $self->path;
  54         return "labeled($type) $label, $uuid at $path";
  55 }
  56
  57
  58 #
  59 # try -- return descriptor for labeled fs, or undef,
  60 # trying a number of formats for superblock.
  61 #
  62 sub try ($) {
  63         my ($path) = @_;
  64         my $result = undef;
  65         my $fh;
  66         if (! open ($fh, "<", "$path")) {
  67                 return $result;
  68         }
  69         binmode ($fh);
  70         $result = tryExt2 ($fh, $path) unless defined $result;
  71         $result = tryReiser ($fh, $path) unless defined $result;
  72
  73         # ignore errors, could not have been very wrong
  74         # if a working superblock came out of it.
  75         close ($fh);
  76         return $result;
  77 }
  78
  79
  80 #
  81 # lets hope the sysadm labeled it in ascii not utf8.
  82 # based on util-linux-2.12h mount; they have lots of other
  83 # superblocks to match.  Later.
  84 #
  85 sub tryExt2 ($$) {
  86         my ($fh, $path) = @_;
  87         my $result = undef;
  88
  89         if (! seek ($fh, 1024, 0)) {
  90                 return $result;
  91         }
  92         # undef on read error - is this worth a warning?
  93         my $superBlock;
  94         my $rc = read ($fh, $superBlock, 1024);
  95         if (! defined ($rc) || $rc != 1024) {
  96                 return $result;
  97         }
  98         my ($magic, $uuid, $label) =
  99                 unpack
 100                 "x[56] v x[34] x[VVV] H[32] Z[16]",
 101                 $superBlock;
 102
 103         if ($magic == 0xEF53) {
 104                 $uuid = fancyUuid ($uuid);
 105                 $result = LabeledPartition->new (
 106                         type => "ext2",
 107                         label => $label,
 108                         uuid => $uuid,
 109                         path => $path,
 110                         );
 111         }
 112         return $result;
 113 }
 114
 115 # fancyUuid - given a hex uuid, add hyphens at conventional place.
 116 sub fancyUuid ($) {
 117         my ($uuid) = @_;
 118         $uuid =~ s/^(.{8})(.{4})(.{4})(.{4})(.{12})$/$1-$2-$3-$4-$5/;
 119         return lc ($uuid);
 120 }
 121
 122 sub tryReiser ($$) {
 123         my ($fh, $path) = @_;
 124         my $result = undef;
 125         # offset in reisser 3.6 (3.5-3.5.10 had 8k)
 126         if (! seek ($fh, (64*1024), 0)) {
 127                 return $result;
 128         }
 129         # undef on read error - is this worth a warning?
 130         my $superBlock;
 131         my $rc = read ($fh, $superBlock, 1024);
 132         if (! defined ($rc) || $rc != 1024) {
 133                 return $result;
 134         }
 135         my ($magic, $uuid, $label) =
 136                 unpack
 137                 "x[52] Z[10] x[22] a[16] Z[16]",
 138                 $superBlock;
 139         my $t = join ("", map { sprintf "%02x", ord($_) } split(//, $uuid));
 140         if ($magic eq "ReIsEr2Fs" || $magic eq "ReIsEr3Fs") {
 141                 $uuid = fancyUuid ($uuid);
 142                 $result = LabeledPartition->new (
 143                         type => "reiserfs",
 144                         label => $label,
 145                         uuid => fancyUuid($t),
 146                         path => $path,
 147                         );
 148         }
 149         return $result;
 150 }
 151
 152 1;