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