lib/SMMID/Role/Site/Files.pm

   1 package SMMID::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 rmtree /;
  11 use URI;
  12
  13 requires qw(
  14             path_to
  15             config
  16             setup_finalize
  17            );
  18
  19
  20 =head2 before setup_finalize
  21
  22 attempt to chown tempfiles_subdir and children to the web user
  23
  24 =cut
  25
  26 before 'setup_finalize' => sub {
  27     my $c = shift;
  28
  29     print STDERR "CURRENT USER IDS: $<, $>\n";
  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->config->{tempfiles_subdir} ) );
  34     my $temp_base   = $c->tempfiles_base;
  35
  36     print STDERR "TEMP_SUBDIR: $temp_subdir\n";
  37     print STDERR "TEMP_BASE: $temp_base\n";
  38
  39
  40     # if clear_tempfiles_on_restart, attempt to delete our temp_base dir
  41     if( $c->config->{clear_tempfiles_on_restart} ) {
  42         $c->log->debug("clear_tempfiles_on_restart set, cleaning $temp_base") if $c->debug;
  43         rmtree( [ $temp_base ] );
  44         if( -e $temp_base ) {
  45             $c->log->warn(
  46                 "WARNING: clear_tempfiles_on_restart set, but failed to completely clean out tempfiles_base '$temp_base':\n"
  47                 .`find '$temp_base' -ls`
  48                );
  49         }
  50     }
  51
  52     print STDERR "symlinking tempfiles_base '$temp_base' -> legacy location '$temp_subdir'\n";
  53     $c->make_generated_dir($temp_base);
  54
  55     # Only symlink if it doesn't exist already
  56     unless( -l $temp_subdir ) {
  57         symlink $temp_base, $temp_subdir or warn "ERROR! $! linking $temp_base => $temp_subdir";
  58     }
  59     else {
  60         print STDERR "$temp_subdir successfully linked to $temp_base\n";
  61     }
  62
  63 #     unless( $temp_subdir eq $temp_base ) {
  64 #         $c->log->warn("WARNING: symlinking tempfiles_subdir() $temp_subdir to $temp_base");
  65 #         unlink $temp_subdir;
  66 #         symlink $temp_subdir, $temp_base
  67 #             or die "$! symlinking $temp_subdir => $temp_base";
  68 #     }
  69
  70     $c->chown_generated_dir( $temp_base ); #< force-set the
  71                                              # permissions on the
  72                                              # main tempfiles dir
  73
  74     # also chown any subdirs that are in the temp dir.
  75     # this line should be removed eventually, the application itself should take
  76     # care of creating temp dirs if it wants.
  77     $c->chown_generated_dir( $_ ) for grep -d, $temp_base->children;
  78
  79 };
  80
  81 =head2 generated_file_uri
  82
  83   Usage: my $dir = $c->generated_file_uri('align_viewer','temp-aln-foo.png');
  84   Desc : get a URI for a file in this site's web-server-accessible
  85          tempfiles directory, relative to the site's base dir.  Use
  86          $c->path_to() to convert it to an absolute path if
  87          necessary
  88   Args : path components to append to the base temp dir, just
  89          like the args taken by File::Spec->catfile()
  90   Ret : path to the file relative to the site base dir.  includes the
  91         leading slash.
  92   Side Effects: attempts to create requested directory if does not
  93                 exist.  dies on error
  94
  95   Example:
  96
  97     my $temp_rel = $c->generated_file_uri('align_viewer','foo.txt')
  98     # might return
  99     /documents/tempfiles/align_viewer/foo.txt
 100     # and then you might do
 101     $c->path_to( $temp_rel );
 102     # to get something like
 103     /data/local/cxgn/core/sgn/documents/tempfiles/align_viewer/foo.txt
 104
 105 =cut
 106
 107 sub generated_file_uri {
 108   my ( $self, @components ) = @_;
 109
 110   @components
 111       or croak 'must provide at least one path component to generated_file_uri';
 112
 113   my $filename = pop @components;
 114
 115   my $dir = $self->tempfiles_subdir( @components );
 116
 117   return URI->new( "$dir/$filename" );
 118 }
 119
 120
 121 =head2 tempfile
 122
 123   Usage   : $c->tempfile( TEMPLATE => 'align_viewer/bar-XXXXXX',
 124                           UNLINK => 0 );
 125   Desc    : a wrapper for File::Temp->new(), to make web-accessible temp
 126             files.  Just runs the TEMPLATE argument through
 127             $c->generated_file_uri().  TEMPLATE can be either just a
 128             filename, or an arrayref of path components.
 129   Returns : a L<File::Temp> object
 130   Args    : same arguments as File::Temp->new(), except:
 131
 132               - TEMPLATE is relative to the site tempfiles base path,
 133                   and can be an arrayref of path components,
 134               - UNLINK defaults to 0, which means that by default
 135                   this temp file WILL NOT be automatically deleted
 136                   when it goes out of scope
 137   Side Eff: dies on error, attempts to create the tempdir if it does
 138             not exist.
 139   Example :
 140
 141     my ($aln_file, $aln_uri) = $c->tempfile( TEMPLATE =>
 142                                                ['align_viewer',
 143                                                 'aln-XXXXXX'
 144                                                ],
 145                                              SUFFIX   => '.png',
 146                                            );
 147     render_image( $aln_file );
 148     print qq|Alignment image: <img src="$aln_uri" />|;
 149
 150 =cut
 151
 152 sub tempfile {
 153   my ( $self, %args ) = @_;
 154
 155   $args{UNLINK} = 0 unless exists $args{UNLINK};
 156
 157   my @path_components = ref $args{TEMPLATE} ? @{$args{TEMPLATE}}
 158                                             : ($args{TEMPLATE});
 159
 160   my $uri = $self->generated_file_uri( @path_components );
 161
 162   my $temp = File::Temp->new( %args,
 163                               # override TEMPLATE with abs path
 164                               TEMPLATE => '' . $self->path_to( $uri ),
 165                              );
 166
 167   # replace the XXXXs in the URI template
 168   ( my $temp_regex = "$uri" ) =~ s/(X+)$/'(\w{'.length($1).'})'/e;
 169   my ($uniq_chars) = "$temp" =~ /$temp_regex/;
 170   my $new_uri = "$uri";
 171   $new_uri =~ s/X+$/$uniq_chars/ or die;
 172   $new_uri .= $args{SUFFIX} if defined $args{SUFFIX};
 173
 174   return ( $temp, URI->new( $new_uri ) );
 175 }
 176
 177 =head2 tempfiles_subdir
 178
 179   Usage: my $dir = $page->tempfiles_subdir('some','dir');
 180   Desc : get a URI for this site's web-server-accessible tempfiles directory.
 181   Args : (optional) one or more directory names to append onto the tempdir root
 182   Ret  : path to dir, relative to doc root, include the leading slash
 183   Side Effects: attempts to create requested directory if does not exist.  dies on error
 184   Example:
 185
 186     $page->tempfiles_subdir('foo')
 187     # might return
 188     /documents/tempfiles/foo
 189
 190 =cut
 191
 192 sub tempfiles_subdir {
 193   my ( $self, @dirs ) = @_;
 194
 195   my $temp_base = $self->config->{tempfiles_subdir}
 196       or die 'no tempfiles_subdir conf var defined!';
 197
 198   my $dir =  File::Spec->catdir( $temp_base, @dirs );
 199
 200   my $abs = $self->path_to($dir);
 201   -d $abs
 202       or $self->make_generated_dir( $abs )
 203       or warn "tempfiles dir '$abs' does not exist, and could not create ($!)";
 204
 205   -w $abs
 206       or $self->chown_generated_dir( $abs )
 207       or warn "could not change permissions of tempdir abs, and '$abs' is not writable.";
 208
 209   $dir = "/$dir" unless $dir =~ m!^/!;
 210
 211   return $dir;
 212 }
 213
 214 sub tempfiles_base {
 215     my $self = shift;
 216     return Path::Class::Dir->new( $self->config->{tempfiles_base} || $self->_default_temp_base );
 217 }
 218
 219 # make a path like /tmp/www-data/SGN-site
 220 sub _default_temp_base {
 221     my ($self) = @_;
 222     return File::Spec->catdir(
 223         File::Spec->tmpdir,
 224         $self->config->{www_user},
 225         ($self->config->{name}.'-site' || die '"name" conf value is not set'),
 226        );
 227 }
 228
 229 sub make_generated_dir {
 230     my ( $self, $tempdir ) = @_;
 231
 232     eval { mkpath( "$tempdir" ); };
 233
 234     if ($@) {
 235         print STDERR "the following error occurred while attempting to generate $tempdir : $@ (may be ok)\n";
 236     }
 237     else { print STDERR "Successfully created dir $tempdir.\n";  }
 238
 239     unless( -d $tempdir ) {
 240         warn "dir '$tempdir' creation failed ($!)";
 241         return;
 242     }
 243
 244     $self->chown_generated_dir( $tempdir );
 245     return 1;
 246 }
 247
 248 # takes one argument, a path in the filesystem, and chowns it appropriately
 249 # intended only to be used here, and in SGN::Apache2::Startup
 250 sub chown_generated_dir {
 251     my ( $self, $temp ) = @_;
 252
 253     if ($< != 0) {
 254         print STDERR "Not running as root - skipping chown of $temp.\n";
 255         return;
 256     }
 257
 258     # NOTE:  $temp can be either a dir or a file
 259
 260     my $www_uid = $self->_www_uid; #< this will warn if group is not set correctly
 261     my $www_gid = $self->_www_gid; #< this will warn if group is not set correctly
 262
 263     return unless $www_uid && $www_gid;
 264
 265     print STDERR "CHOWNING WITH $www_uid, $www_gid\n";
 266
 267     chown $www_uid, $www_gid, $temp;
 268
 269     # 02775 = sticky group bit (makes files created in that dir belong to that group),
 270     #         rwx for user,
 271     #         rwx for group,
 272     #         r-x for others
 273
 274     # to avoid version control problems, site maintainers should just
 275     # be members of the www-data group
 276     chmod 02775, $temp;
 277
 278     return 1;
 279 }
 280 sub _www_gid {
 281     my $self = shift;
 282     my $grname = $self->config->{www_group};
 283     my $gid = (getgrnam $grname )[2];
 284     defined $gid or warn "WARNING: www_group '$grname' does not exist, please check configuration\n";
 285     return $gid;
 286 }
 287 sub _www_uid {
 288     my $self = shift;
 289     my $uname = $self->config->{www_user};
 290     my $uid = (getpwnam( $uname ))[2];
 291     defined $uid or warn "WARNING: www_user '$uname' does not exist, please check configuration\n";
 292     return $uid;
 293 }
 294
 295 =head2 uri_for_file
 296
 297   Usage: $page->uri_for_file( $absolute_file_path );
 298   Desc : for a file on the filesystem, get the URI for clients to
 299          access it
 300   Args : absolute file path in the filesystem
 301   Ret  : L<URI> object
 302   Side Effects: dies on error
 303
 304   This is intended to be similar to Catalyst's $c->uri_for() method,
 305   to smooth our transition to Catalyst.
 306
 307 =cut
 308
 309 sub uri_for_file {
 310     my ( $self, @abs_path ) = @_;
 311
 312     my $abs = File::Spec->catfile( @abs_path );
 313     $abs = Cwd::realpath( $abs );
 314
 315     my $basepath = $self->config->{basepath}
 316       or die "no base path conf variable defined";
 317     -d $basepath or die "base path '$basepath' does not exist!";
 318     $basepath = Cwd::realpath( $basepath );
 319
 320     $abs =~ s/^$basepath//;
 321     $abs =~ s!\\!/!g;
 322
 323     return URI->new($abs);
 324 }
 325
 326 =head2 site_cluster_shared_dir
 327
 328  Usage:        my $dir = $c->site_cluster_shared_dir();
 329  Desc:         returns the site-specific subdir that is cluster shareable.
 330  Ret:          ditto
 331  Args:         none
 332  Side Effects: none
 333  Example:
 334
 335 =cut
 336
 337 sub site_cluster_shared_dir {
 338     my $self = shift;
 339
 340     my $host = $self->req->base;
 341     $host    =~ s/(https?)|(:\d+)|\/|://g;
 342     $host    =~ s/(www\.)//;
 343     $host    = File::Spec->catdir($self->config->{cluster_shared_tempdir}, $host);
 344
 345     return $host;
 346
 347 }
 348
 349 1;