view release on metacpan or  search on metacpan

lib/App/Phoebe/Capsules.pm  view on Meta::CPAN

  return 'image/png' if /\.png$/i;
  return 'image/jpeg' if /\.jpe?g$/i;
  return 'image/gif' if /\.gif$/i;
  return 'application/octet-stream';
}

sub capsule_token_cleanup {
  # only keep tokens created in the last 10 minutes
  my $ts = time - 600;
  @capsule_tokens = grep { $_->[0] > $ts } @capsule_tokens;
}

unshift(@request_handlers, '^titan://(' . capsule_regex() . ')(?::\d+)?/' . $capsule_space . '/' => \&handle_titan);

# We need our own Titan handler because we want a different copy of is_upload;
# and once we're here we can run our extension directly.
sub handle_titan {
  my $stream = shift;
  my $data = shift;
  # extra processing of the request if we didn't do that, yet
  $data->{upload} ||= is_upload($stream, $data->{request}) or return;
  my $size = $data->{upload}->{params}->{size};
  my $actual = length($data->{buffer});
  if ($actual == $size) {
    save_file($stream, $data->{request}, $data->{upload}, $data->{buffer}, $size);
    $stream->close_gracefully();
    return;
  } elsif ($actual > $size) {
    $log->debug("Received more than the promised $size bytes");
    result($stream, "59", "Received more than the promised $size bytes");
    $stream->close_gracefully();
    return;
  }
  $log->debug("Waiting for " . ($size - $actual) . " more bytes");
}

# We need our own is_upload because the regular expression is different.
sub is_upload {
  my $stream = shift;
  my $request = shift;
  $log->info("Looking at capsule $request");
  my $hosts = capsule_regex();
  my $port = port($stream);
  if ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/([^/?#;]+);([^?#]+)$!) {
    my $host = $1;
    my ($capsule, $id, %params) = map {decode_utf8(uri_unescape($_))} $2, $3, split(/[;=&]/, $4);
    if (valid_params($stream, $host, $capsule_space, $id, \%params)) {
      return {
	host => $host,
	space => $capsule_space,
	capsule => $capsule,
	id => $id,
	params => \%params,
      }
    }
    # valid_params printed a response and closed the stream
    return;
  }
  $log->debug("Capsule upload with malformed titan URL");
  if ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/([^/?#;]+);([^?#]*)[?#]!) {
    result($stream, "59", "The titan URL must not have a query or a fragment at the end");
  } elsif ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/([^/?#;]+)/!) {
    result($stream, "59", "These capsules do not allow uploads for subdirectories");
  } elsif ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/([^/?#;]+)$!) {
    result($stream, "59", "The titan URL is missing the parameters after a semikolon $1 $2 $3 $4");
  } elsif ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/([^/?#;]+)/?(;.*)$!) {
    result($stream, "59", "The titan URL is missing the file name");
  } elsif ($request =~ m!^titan://($hosts)(?::$port)?/$capsule_space/?$!) {
    result($stream, "59", "The titan URL is missing the capsule name and the file name");
  } else {
    result($stream, "59", "The titan URL is malformed");
  }
  $stream->close_gracefully();
  return;
}

# We need our own valid_params because we don't check the token but we do check
# the extension
sub valid_params {
  my $stream = shift;
  my $host = shift;
  my $space = shift;
  my $id = shift;
  my $params = shift;
  return unless valid_id($stream, $host, $space, $id, $params);
  # return unless valid_token($stream, $host, $space, $id, $params);
  $params->{mime} = mime_type($id);
  return unless valid_mime_type($stream, $host, $space, $id, $params);
  return unless valid_size($stream, $host, $space, $id, $params);
  return 1;
}

sub save_file {
  my ($stream, $url, $upload, $buffer, $size) = @_;
  my $name = capsule_name($stream);
  my $capsule = $upload->{capsule} || "";
  if (not $name) {
    $log->debug("Missing certificate for capsule upload");
    return result($stream, "60", "Uploading files requires a client certificate");
  } elsif ($name ne $capsule) {
    $log->debug("Wrong certificate for capsule upload: $name vs $capsule");
    return result($stream, "61", "This is not your space: your certificate authorizes you for $name");
  }
  return result($stream, "50", "Titan upload failed")
      unless defined $buffer and defined $size and $upload->{id}
      and $upload->{space} and $upload->{space} eq "capsule";
  my $host = $upload->{host};
  my $dir = capsule_dir($host, $capsule);
  my $id = $upload->{id};
  my $file = $dir . "/" . encode_utf8($id);
  if ($size == 0) {
    return result($stream, "51", "This capsule does not exist") unless -d $dir;
    return result($stream, "51", "This file does not exist") unless -f $file;
    return result($stream, "40", "Cannot delete this file") unless unlink $file;
    $log->info("Deleted $file");
  } else {
    mkdir($dir) unless -d $dir;
    backup($dir, $id);
    write_binary($file, $buffer);
    $log->info("Wrote $file");
    return result($stream, "30", to_url($stream, $host, $capsule_space, $capsule));