lib/SGN/Role/Site/Files.pm

   1 package SGN::Role::Site::Files;
   2
   3 use Moose::Role;
   4 use namespace::autoclean;
   5
   6 use Carp;
   7 use Cwd;
   8 use File::Spec;
   9 use File::Temp;
  10 use File::Path qw/ mkpath /;
  11 use URI;
  12
  13 requires qw(
  14             get_conf
  15             path_to
  16             config
  17             setup_finalize
  18            );
  19
  20
  21 =head2 before setup_finalize
  22
  23 attempt to chown tempfiles_subdir and children to the web user
  24
  25 =cut
  26
  27 before 'setup_finalize' => sub {
  28     my $c = shift;
  29
  30     # the tempfiles_subdir() function makes and chmods the given
  31     # directory.  with no arguments, will make and chmod the main
  32     # tempfiles directory
  33     my $temp_subdir = Path::Class::Dir->new( $c->path_to( $c->get_conf('tempfiles_subdir') ) );
  34     my $temp_base   = $c->tempfiles_base;
  35     $c->log->debug("linking $temp_base => $temp_subdir") if $c->debug;
  36     $c->make_generated_dir($temp_base);
  37     unlink $temp_subdir;
  38     symlink $temp_base, $temp_subdir or die "$! linking $temp_base => $temp_subdir";
  39
  40 #     unless( $temp_subdir eq $temp_base ) {
  41 #         $c->log->warn("WARNING: symlinking tempfiles_subdir() $temp_subdir to $temp_base");
  42 #         unlink $temp_subdir;
  43 #         symlink $temp_subdir, $temp_base
  44 #             or die "$! symlinking $temp_subdir => $temp_base";
  45 #     }
  46
  47     $c->chown_generated_dir( $temp_subdir ); #< force-set the
  48                                              # permissions on the
  49                                              # main tempfiles dir
  50
  51     # also chown any subdirs that are in the temp dir.
  52     # this line should be removed eventually, the application itself should take
  53     # care of creating temp dirs if it wants.
  54     $c->chown_generated_dir( $_ ) for grep -d, $temp_subdir->children;
  55
  56 };
  57
  58 =head2 generated_file_uri
  59
  60   Usage: my $dir = $c->generated_file_uri('align_viewer','temp-aln-foo.png');
  61   Desc : get a URI for a file in this site's web-server-accessible
  62          tempfiles directory, relative to the site's base dir.  Use
  63          $c->path_to() to convert it to an absolute path if
  64          necessary
  65   Args : path components to append to the base temp dir, just
  66          like the args taken by File::Spec->catfile()
  67   Ret : path to the file relative to the site base dir.  includes the
  68         leading slash.
  69   Side Effects: attempts to create requested directory if does not
  70                 exist.  dies on error
  71
  72   Example:
  73
  74     my $temp_rel = $c->generated_file_uri('align_viewer','foo.txt')
  75     # might return
  76     /documents/tempfiles/align_viewer/foo.txt
  77     # and then you might do
  78     $c->path_to( $temp_rel );
  79     # to get something like
  80     /data/local/cxgn/core/sgn/documents/tempfiles/align_viewer/foo.txt
  81
  82 =cut
  83
  84 sub generated_file_uri {
  85   my ( $self, @components ) = @_;
  86
  87   @components
  88       or croak 'must provide at least one path component to generated_file_uri';
  89
  90   my $filename = pop @components;
  91
  92   my $dir = $self->tempfiles_subdir( @components );
  93
  94   return URI->new( "$dir/$filename" );
  95 }
  96
  97
  98 =head2 tempfile
  99
 100   Usage   : $c->tempfile( TEMPLATE => 'align_viewer/bar-XXXXXX',
 101                           UNLINK => 0 );
 102   Desc    : a wrapper for File::Temp->new(), to make web-accessible temp
 103             files.  Just runs the TEMPLATE argument through
 104             $c->generated_file_uri().  TEMPLATE can be either just a
 105             filename, or an arrayref of path components.
 106   Returns : a L<File::Temp> object
 107   Args    : same arguments as File::Temp->new(), except:
 108
 109               - TEMPLATE is relative to the site tempfiles base path,
 110                   and can be an arrayref of path components,
 111               - UNLINK defaults to 0, which means that by default
 112                   this temp file WILL NOT be automatically deleted
 113                   when it goes out of scope
 114   Side Eff: dies on error, attempts to create the tempdir if it does
 115             not exist.
 116   Example :
 117
 118     my ($aln_file, $aln_uri) = $c->tempfile( TEMPLATE =>
 119                                                ['align_viewer',
 120                                                 'aln-XXXXXX'
 121                                                ],
 122                                              SUFFIX   => '.png',
 123                                            );
 124     render_image( $aln_file );
 125     print qq|Alignment image: <img src="$aln_uri" />|;
 126
 127 =cut
 128
 129 sub tempfile {
 130   my ( $self, %args ) = @_;
 131
 132   $args{UNLINK} = 0 unless exists $args{UNLINK};
 133
 134   my @path_components = ref $args{TEMPLATE} ? @{$args{TEMPLATE}}
 135                                             : ($args{TEMPLATE});
 136
 137   $args{TEMPLATE} = '' . $self->path_to( $self->generated_file_uri( @path_components ) );
 138   return File::Temp->new( %args );
 139 }
 140
 141 =head2 tempfiles_subdir
 142
 143   Usage: my $dir = $page->tempfiles_subdir('some','dir');
 144   Desc : get a URI for this site's web-server-accessible tempfiles directory.
 145   Args : (optional) one or more directory names to append onto the tempdir root
 146   Ret  : path to dir, relative to doc root, include the leading slash
 147   Side Effects: attempts to create requested directory if does not exist.  dies on error
 148   Example:
 149
 150     $page->tempfiles_subdir('foo')
 151     # might return
 152     /documents/tempfiles/foo
 153
 154 =cut
 155
 156 sub tempfiles_subdir {
 157   my ( $self, @dirs ) = @_;
 158
 159   my $temp_base = $self->get_conf('tempfiles_subdir')
 160       or die 'no tempfiles_subdir conf var defined!';
 161
 162   my $dir =  File::Spec->catdir( $temp_base, @dirs );
 163
 164   my $abs = $self->path_to($dir);
 165   -d $abs
 166       or $self->make_generated_dir( $abs )
 167       or confess "tempfiles dir '$abs' does not exist, and could not create ($!)";
 168
 169   -w $abs
 170       or $self->chown_generated_dir( $abs )
 171       or confess "could not change permissions of tempdir abs, and '$abs' is not writable. aborting.";
 172
 173   $dir = "/$dir" unless $dir =~ m!^/!;
 174
 175   return $dir;
 176 }
 177
 178 sub tempfiles_base {
 179     my $self = shift;
 180     return Path::Class::Dir->new( $self->config->{tempfiles_base} || $self->_default_temp_base );
 181 }
 182
 183 # make a path like /tmp/www-data/SGN-site
 184 sub _default_temp_base {
 185     my ($self) = @_;
 186     return File::Spec->catdir(
 187         File::Spec->tmpdir,
 188         $self->config->{www_user},
 189         ($self->config->{name}.'-site' || die '"name" conf value is not set'),
 190        );
 191 }
 192
 193 sub make_generated_dir {
 194     my ( $self, $tempdir ) = @_;
 195
 196     mkpath( "$tempdir" );
 197     unless( -d $tempdir ) {
 198         warn "dir '$tempdir' creation failed ($!)";
 199         return;
 200     }
 201
 202     $self->chown_generated_dir( $tempdir );
 203     return 1;
 204 }
 205
 206 # takes one argument, a path in the filesystem, and chowns it appropriately
 207 # intended only to be used here, and in SGN::Apache2::Startup
 208 sub chown_generated_dir {
 209     my ( $self, $temp ) = @_;
 210     # NOTE:  $temp can be either a dir or a file
 211
 212     my $www_uid = $self->_www_uid; #< this will warn if group is not set correctly
 213     my $www_gid = $self->_www_gid; #< this will warn if group is not set correctly
 214
 215     return unless $www_uid && $www_gid;
 216
 217     chown -1, $www_gid, $temp;
 218
 219     # 02775 = sticky group bit (makes files created in that dir belong to that group),
 220     #         rwx for user,
 221     #         rwx for group,
 222     #         r-x for others
 223
 224     # to avoid version control problems, site maintainers should just
 225     # be members of the www-data group
 226     chmod 02775, $temp;
 227
 228     return 1;
 229 }
 230 sub _www_gid {
 231     my $self = shift;
 232     my $grname = $self->config->{www_group};
 233     my $gid = (getgrnam $grname )[2];
 234     defined $gid or warn "WARNING: www_group '$grname' does not exist, please check configuration\n";
 235     return $gid;
 236 }
 237 sub _www_uid {
 238     my $self = shift;
 239     my $uname = $self->config->{www_user};
 240     my $uid = (getpwnam( $uname ))[2];
 241     defined $uid or warn "WARNING: www_user '$uname' does not exist, please check configuration\n";
 242     return $uid;
 243 }
 244
 245 =head2 uri_for_file
 246
 247   Usage: $page->uri_for_file( $absolute_file_path );
 248   Desc : for a file on the filesystem, get the URI for clients to
 249          access it
 250   Args : absolute file path in the filesystem
 251   Ret  : L<URI> object
 252   Side Effects: dies on error
 253
 254   This is intended to be similar to Catalyst's $c->uri_for() method,
 255   to smooth our transition to Catalyst.
 256
 257 =cut
 258
 259 sub uri_for_file {
 260     my ( $self, @abs_path ) = @_;
 261
 262     my $abs = File::Spec->catfile( @abs_path );
 263     $abs = Cwd::realpath( $abs );
 264
 265     my $basepath = $self->get_conf('basepath')
 266       or die "no base path conf variable defined";
 267     -d $basepath or die "base path '$basepath' does not exist!";
 268     $basepath = Cwd::realpath( $basepath );
 269
 270     $abs =~ s/^$basepath//;
 271     $abs =~ s!\\!/!g;
 272
 273     return URI->new($abs);
 274 }
 275
 276
 277
 278
 279 1;