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