From d081cacacb3697569b08a925f23c4239e4616543 Mon Sep 17 00:00:00 2001 From: Olli-Antti Kivilahti Date: Mon, 23 Oct 2017 14:12:15 +0300 Subject: [PATCH] Bug 19512 - Koha::File - wrapper/utility routines for file handling Add getDiagnostics() usable by Exceptions to gather more information about a file and why accessing it failed. --- Koha/Exceptions/File.pm | 51 ++++++++++++++++++++++++++++++++++++++++++++++ Koha/File.pm | 53 ++++++++++++++++++++++++++++++++++++++++++++++++ t/Koha/Exceptions/File.t | 35 ++++++++++++++++++++++++++++++++ t/Koha/File.t | 38 ++++++++++++++++++++++++++++++++++ 4 files changed, 177 insertions(+) create mode 100644 Koha/Exceptions/File.pm create mode 100644 Koha/File.pm create mode 100644 t/Koha/Exceptions/File.t create mode 100644 t/Koha/File.t diff --git a/Koha/Exceptions/File.pm b/Koha/Exceptions/File.pm new file mode 100644 index 0000000..8353e04 --- /dev/null +++ b/Koha/Exceptions/File.pm @@ -0,0 +1,51 @@ +package Koha::Exceptions::File; + +use Modern::Perl; + +use File::Basename; + +use Koha::File; + +use Koha::Exceptions; + +use Exception::Class ( + + 'Koha::Exceptions::File' => { + isa => 'Koha::Exceptions::Exception', + description => 'Problem with a file', + fields => ['path', 'stat'], + }, +); + +=head2 throw +@OVERLOADS + +Adds diagnostic information regarding the file with issues + +=cut + +sub throw { + my ($self, %args) = @_; + my @pwuid = getpwuid($<); + my $realUser = $pwuid[0]; + @pwuid = getpwuid($>); + my $effectiveUser = $pwuid[0]; + + my $stat = 'File permissions:> '; + if (-e $args{path}) { + $stat .= Koha::File::getDiagnosticsString($args{path}); + } + else { + $stat .= "FILE NOT EXISTS."; + my $parentDir = File::Basename::dirname($args{path}); + $stat .= " Parent directory '$parentDir' permissions:> ".(Koha::File::getDiagnosticsString( $parentDir ) || 'DIR NOT EXISTS'); + } + + $stat .= ", Real user:> $realUser, Effective user:> $effectiveUser"; + $args{stat} = $stat; + + $args{error} .= '. '.$stat; + $self->SUPER::throw(%args); +} + +1; diff --git a/Koha/File.pm b/Koha/File.pm new file mode 100644 index 0000000..87e0cb8 --- /dev/null +++ b/Koha/File.pm @@ -0,0 +1,53 @@ +package Koha::File; + +use Modern::Perl; + +use Fcntl; + +=head1 SYNOPSIS + +This package providers helper methods to work with files +Maybe even be a wrapper in Koha for working with files some day? + +=cut + +our @filetypes; #Save the translation table for filetypes for global access +$filetypes[Fcntl::S_IFDIR] = "d"; +$filetypes[Fcntl::S_IFCHR] = "c"; +$filetypes[Fcntl::S_IFBLK] = "b"; +$filetypes[Fcntl::S_IFREG] = "-"; +$filetypes[Fcntl::S_IFIFO] = "p"; +$filetypes[Fcntl::S_IFLNK] = "l"; +$filetypes[Fcntl::S_IFSOCK] = "s"; + +=head2 getDiagnostics + +@PARAM1 String, path to a file +@RETURNS HASHRef, file properties in clear text. + undef, if no such file found +@THROWS nothing, do not throw from here, especially not File-exceptions, + because this subroutine is used in File-exception diagnostics and could cause a circular recursion when no file is found. + +=cut + +sub getDiagnostics { + my ($path) = @_; + my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = lstat($path); + return undef unless $dev; #No such file + + my %rv; + $rv{user} = getpwuid($uid); + $rv{group} = getgrgid($gid); + $rv{permissions} = sprintf "%04o", Fcntl::S_IMODE($mode); + $rv{filetype} = $filetypes[ Fcntl::S_IFMT($mode) ]; + + return \%rv; +} + +our $diagnosticsStringFormat = '%s %s %s:%s'; +sub getDiagnosticsString { + my $stat = getDiagnostics(@_); + return sprintf($diagnosticsStringFormat, $stat->{filetype}, $stat->{permissions}, $stat->{user}, $stat->{group}); +} + +1; diff --git a/t/Koha/Exceptions/File.t b/t/Koha/Exceptions/File.t new file mode 100644 index 0000000..ddca7f0 --- /dev/null +++ b/t/Koha/Exceptions/File.t @@ -0,0 +1,35 @@ +use Modern::Perl; +use Test::More; + +use Try::Tiny; +use File::Basename; + +use Koha::Exceptions::File; + +#file diagnostics are more throughly tested in t/Koha/File.t +subtest "Catch File-exception and inspect diagnostics", \&getDiagnostics; +sub getDiagnostics { + my $file = $ENV{KOHA_PATH}.'/kohaversion.pl'; + my $parentDir = File::Basename::dirname($file); + try { + Koha::Exceptions::File->throw(error => "error", path => $file); + ok(0, "??Why no throw exception??"); + } catch { my $e = $_; + ok($e->isa('Koha::Exceptions::File'), "Given the expected exception"); + like($e->stat, qr/^\w+/, "Then the file diagnostics look legit"); + }; + + $file = $ENV{KOHA_PATH}.'/koha-aversion.pl'; + try { + Koha::Exceptions::File->throw(error => "error", path => $file); + ok(0, "??Why no throw exception??"); + } catch { my $e = $_; + ok($e->isa('Koha::Exceptions::File'), "Given the expected exception"); + like($e->stat, qr/^\w+/, "Then the file diagnostics look legit"); + like($e->stat, qr/FILE NOT EXISTS/, "And file doesn't exist"); + like($e->stat, qr/Parent directory '$parentDir' permissions/, "And parent directory diagnostics delivered"); + }; +} + + +done_testing; diff --git a/t/Koha/File.t b/t/Koha/File.t new file mode 100644 index 0000000..8ad2a71 --- /dev/null +++ b/t/Koha/File.t @@ -0,0 +1,38 @@ +use Modern::Perl; +use Test::More; + +use Koha::File; + +subtest "Test file diagnostic", \&getDiagnostics; +sub getDiagnostics { + _testDiagnostics($ENV{KOHA_PATH}.'/kohaversion.pl', '-'); + _testDiagnostics($ENV{KOHA_PATH}.'/xt', 'd'); +} + + +done_testing; + + +sub _testDiagnostics { + my ($filepath, $expectedFiletype) = @_; + my @expected = ( + $expectedFiletype, + sprintf("%04o", ((lstat($filepath))[2] & 07777)), #$expectedPermissions, + scalar(getpwuid((lstat($filepath))[4])), #$expectedUser, + scalar(getgrgid((lstat($filepath))[5])), #$expectedGroup, + ); + + ok( my $diag = Koha::File::getDiagnostics($filepath), + "Given file '$filepath' exists and diagnostics received"); + is( $diag->{user}, $expected[2], + "Then file owner matches"); + is( $diag->{group}, $expected[3], + "Then file group matches"); + is( $diag->{permissions}, $expected[1], + "Then file permissions match"); + is( $diag->{filetype}, $expected[0], + "Then filetype is $expected[0]"); + + is(Koha::File::getDiagnosticsString($filepath), sprintf($Koha::File::diagnosticsStringFormat, @expected), + "Then the diagnostic string matches"); +} -- 2.7.4