1# $Id: Filesys.pm,v 1.4 2003/10/26 03:31:13 ianb Exp $ 2package MP3::Archive::Lint::Tools::Filesys; 3 4use strict; 5use warnings; 6 7use MP3::Archive::Lint::Tool; 8use File::stat (); 9 10use vars qw(@ISA $VERSION); 11@ISA = qw(MP3::Archive::Lint::Tool); 12$VERSION = '0.01'; 13 14=head1 filesys - Tool for misc filesys tests 15 16Various checks that don't belong anywhere else and are related to the file system. 17 18=head2 Tests 19 20=over 4 21 22=cut 23 24sub new 25{ 26 my $proto=shift; 27 my $class=ref($proto) || $proto; 28 my $opts=shift; 29 my $self=$class->SUPER::new($opts); 30 bless($self,$class); 31 32 $self->{perms_file}=$self->config->get("lint_perms_file"); 33 $self->{perms_dir}=$self->config->get("lint_perms_dir"); 34 35 $self->settests("empty","perms"); 36 $self->{wantfileerrors}=1; 37 38 return $self; 39} 40 41sub initscan 42{ 43 my $self=shift; 44 $self->settests("access"); 45 if(-e $self->{file}) 46 { 47 my $stat=File::stat::stat($self->{file}); 48 if($stat) 49 { 50 $self->settests("access","empty","perms"); 51 $self->{mode}=$stat->mode & 07777; 52 } 53 } 54 return 1; 55} 56 57 58=item B<empty> 59 60Checks for zero-length files. 61 62=cut 63 64sub empty 65{ 66 my $self=shift; 67 if(-z $self->{file}) 68 { 69 $self->say("file is empty"); 70 } 71} 72 73=item B<access> 74 75Checks for non-existant or unreadable files and broken symbolic links. 76 77=cut 78 79sub access 80{ 81 my $self=shift; 82 if(!-e $self->{file}) 83 { 84 if(-l $self->{file}) 85 { 86 my $link=readlink($self->{file}); 87 if(!defined($link)) 88 { 89 $link=""; 90 } 91 else 92 { 93 $link=":$link"; 94 } 95 $self->say("broken link$link"); 96 } 97 else 98 { 99 $self->say("file not found"); 100 } 101 } 102 elsif(!-r $self->{file}) 103 { 104 $self->say("file unreadable"); 105 } 106} 107 108=item B<perms> 109 110Checks permissions. If -F (fix) is specified, attempts 111to fix incorrect permissions. 112 113Variables: 114 115=over 4 116 117=item $perms_file 118 119(octal number, default 0644 (rw-r--r--)) 120 121=item $perms_dir 122 123(octal number, default 0755 (rwxr-xr-x)) 124 125=back 126 127For details on the encoding of permissions, see L<chmod(1)>, 128but briefly, the value consists of a leading 0, then 3 digits, 129one each for the user, group, and everyone else. Each digit is 130the sum of the values I<4> for write, I<2> for read, and I<1> 131for execute. 132 133For instance, if you wanted full access for yourself, read and execute 134for your group, and no access for anyone else, you would use (r+w+x = 1354+2+1 =) 7 for user, (r+x = 4+1=) 5 for group and 0 for world 136(everyone else). Putting this together, we get B<0750> 137 138Example values: 139 140 0700 = rwx------ 141 0751 = rwxr-x--x 142 0604 = rw-----w- 143 0124 = --x-w-r-- 144 145If you want to let other users on your machine read your files, use 146I<0644> (rw-r--r--) for C<$perms_file> and I<0755> (rw-r--r--) for 147C<$perms_dir>. If you want to keep your files private, use I<0600> 148(rw-------) for C<$perms_file> and I<0700> (rwx------) for 149C<$perms_dir> 150 151Directories need to have their "x" flag set if you want people to be 152able to change into them. 153 154It is essential that C<$perms_dir> and C<$perms_file> start with a 0, 155eg I<0755> not I<755>, for them to correctly be interpreted as 156octal values. 157 158=cut 159 160sub perms 161{ 162 my $self=shift; 163 my $wantperms; 164 165 if(-d $self->{file}) 166 { 167 $wantperms=$self->{perms_dir}; 168 } 169 else 170 { 171 $wantperms=$self->{perms_file}; 172 } 173 174 if($self->{mode} != $wantperms) 175 { 176 if($self->config->fix) 177 { 178 if(chmod($wantperms,$self->{file})) 179 { 180 $self->say("fixed:permissions set to ".sprintf("%04o",$wantperms)); 181 } 182 else 183 { 184 $self->say("error - could not fix permissions:$!"); 185 } 186 } 187 else 188 { 189 $self->say(sprintf("wrong permissions:%04o (should be %04o)",$self->{mode},$wantperms)); 190 } 191 return 0; 192 } 193} 194 195=back 196 197=cut 198 1991; 200