content-type results from the CPAN

content-type

App-Phoebe

view release on metacpan or search on metacpan

  my $file = "$dir/file/$id";
  my $meta = "$dir/meta/$id";
  if (not -f $file) {
    result($stream, "40", "File not found");
    return;
  } elsif (not -f $meta) {
    result($stream, "40", "Metadata not found");
    return;
  }
  my %meta = (map { split(/: /, $_, 2) } split /\n/, read_text $meta);
  if (not $meta{'content-type'}) {
    result($stream, "59", "Metadata corrupt");
    return;
  }
  success($stream, $meta{'content-type'});
  $stream->write(read_binary($file));
}

sub bogus_hash {
  my $str = shift;
  return "0000" unless $str;
  my $num = unpack("L",B::hash($str)); # 32-bit integer
  my $code = sprintf("%o", $num); # octal is 0-7
  return substr($code, 0, 4); # four numbers
}

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

    say $fh join("\x1f", scalar(time), $id, 0, bogus_hash($peerhost));
    close($fh);
  }
  mkdir "$dir/file" unless -d "$dir/file";
  eval { write_binary($file, $data) };
  if ($@) {
    result($stream, "59", "Unable to save $id");
    return;
  }
  mkdir "$dir/meta" unless -d "$dir/meta";
  eval { write_text($meta, "content-type: $type\n") };
  if ($@) {
    result($stream, "59", "Unable to save metadata for $id");
    return;
  }
  $log->info("Wrote $id");
  result($stream, "30", to_url($stream, $host, $space, "file/$id"));
}

sub delete_file {
  my $stream = shift;

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

    $stream->write("File not found\r\n");
    return;
  } elsif (not -f $meta) {
    $stream->write("HTTP/1.1 500 Error\r\n");
    $stream->write("Content-Type: text/plain\r\n");
    $stream->write("\r\n");
    $stream->write("Metadata not found\r\n");
    return;
  }
  my %meta = (map { split(/: /, $_, 2) } split /\n/, read_text $meta);
  if (not $meta{'content-type'}) {
    $stream->write("HTTP/1.1 500 Error\r\n");
    $stream->write("Content-Type: text/plain\r\n");
    $stream->write("\r\n");
    $stream->write("Metadata corrupt\r\n");
    return;
  }
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("Content-Type: " . $meta{'content-type'} ."\r\n");
  $stream->write("\r\n");
  $stream->write(read_binary($file));
}

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

      # the raw directory is a "fake" and is actually the page directory
      $filename = $dir . "/page/$1.gmi";
      $is_dir = 0;
      $mime = "text/plain";
    } elsif ($resource =~ m!/file/([^/]+)$!) {
      $filename = $dir . $resource;
      $is_dir = 0;
      if (-f "$dir/meta/$1") {
	# MIME-type for files requires opening the meta files! ðŸ˜
	my %meta = (map { split(/: /, $_, 2) } split /\n/, read_text "$dir/meta/$1");
	if ($meta{'content-type'}) {
	  $mime = $meta{'content-type'};
	}
      }
      $mime //= "application/octet-stream"; # fallback for binary files
    } else {
      $log->error("Requested $resource");
      next;
    }

    $log->debug("Processing $dir$resource");

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

  my $d = substr($resource, -1) eq "/";
  $href .= join("/", map { uri_escape_utf8($_) } split (/\//, $resource));
  $href .= "/" if $d;
  return $href;
}

sub put {
  my ($stream, $host, $space, $path, $id, $headers, $buffer) = @_;
  return unless authorize($stream, $host, $space, $headers);
  return remove($stream, $host, $space, $path, $id, $headers) if length($buffer) == 0;
  my $mime = $headers->{"content-type"} // guess_mime_type(\$buffer);
  return webdav_error($stream, "Content type not known") unless $mime;
  return webdav_error($stream, "Page name is missing") unless $id;
  return webdav_error($stream, "Page names must not control characters") if $id =~ /[[:cntrl:]]/;
  # We don't need to close the stream because this is called via process_gemini
  # which always closes the stream in the end.
  if ($path eq "/file/$id") {
    with_lock($stream, $host, $space, sub { write_file($stream, $host, $space, $id, $buffer, $mime) } );
  } else {
    my $text = decode_utf8 $buffer // "";
    $text =~ s/\r\n/\n/g; # fix DOS EOL convention

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

    say $fh join("\x1f", scalar(time), $id, 0, bogus_hash($peerhost));
    close($fh);
  }
  mkdir "$dir/file" unless -d "$dir/file";
  eval { write_binary($file, $data) };
  if ($@) {
    $log->error("Unable to save $id: $@");
    return webdav_error($stream, "Unable to save $id");
  }
  mkdir "$dir/meta" unless -d "$dir/meta";
  eval { write_text($meta, "content-type: $type\n") };
  if ($@) {
    $log->error("Unable to save metadata for $id: $@");
    return webdav_error($stream, "Unable to save metadata for $id");
  }
  $log->info("Wrote $id");
  if ($new) {
    $stream->write("HTTP/1.1 201 Created\r\n");
  } else {
    $stream->write("HTTP/1.1 200 OK\r\n");
  }

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

  $stream->write("</body>\n");
  $stream->write("</html>\n");
}

sub save_edit_via_http {
  my ($stream, $host, $space, $id, $headers, $buffer) = @_;
  $log->info("Save edit for $id via HTTP");
  return http_error($stream, "Page name is missing") unless $id;
  return http_error($stream, "Page names must not control characters") if $id =~ /[[:cntrl:]]/;
  return http_error($stream, "Content type not known")
      if not $headers->{"content-type"} or $headers->{"content-type"} ne "application/x-www-form-urlencoded";
  my %params;
  for (split(/&/, $buffer)) {
    my ($key, $value) = map { s/\+/ /g; decode_utf8(uri_unescape($_)) } split(/=/, $_, 2);
    $params{$key} = $value;
  }
  $log->debug("Parameters: " . join(", ", map { "$_ => '$params{$_}'" } keys %params));
  my $token = quotemeta($params{token}||"");
  my @tokens = @{$server->{wiki_token}};
  push(@tokens, @{$server->{wiki_space_token}->{$space}})
      if $space and $server->{wiki_space_token}->{$space};

script/phoebe view on Meta::CPAN

each revision gets an apropriate number)

F<file> is the directory with all the uploaded files in it â€“ if you haven't
uploaded any files, then it won't exist; you must explicitly allow MIME types
for upload using the C<--wiki_mime_type> option (see I<Options> below)

F<meta> is the directory with all the meta data for uploaded files in it â€“ there
should be a file here for every file in the F<file> directory; if you create new
files in the F<file> directory, you should create a matching file here; if you
have a file F<file/alex.jpg> you want to create a file F<meta/alex.jpg>
containing the line C<content-type: image/jpeg>

F<changes.log> is a file listing all the pages made to the wiki; if you make
changes to the files in the F<page> or F<file> directory, they aren't going to
be listed in this file and thus people will be confused by the changes you made
â€“ your call (but in all fairness, if you're collaborating with others you
probably shouldn't do this); the format is one change per line, with lines
separated from each other by a single C<\n>, and each line consisting of time
stamp, pagename or filename, revision number if a page or 0 if a file, and the
numeric code of the user making the edit (see L</Privacy> below), all separated
from each other with a C<\x1f>

t/Web.t view on Meta::CPAN

write_text("$dir/page/Berta.gmi", "```\nHello!\nYo!\n```\n");
write_text("$dir/page/Chris.gmi", "=> Alex\n");
my $ts = time;
my $changes = join("\x1f", $ts - 300, "Alex", 1, "1111\n")
    . join("\x1f", $ts - 200, "Berta", 1, "1111\n")
    . join("\x1f", $ts - 100, "Alex", 1, "1111\n");
write_text("$dir/changes.log", $changes);
mkdir("$dir/file");
write_binary("$dir/file/alex.jpg", read_binary("t/alex.jpg"));
mkdir("$dir/meta");
write_text("$dir/meta/alex.jpg", "content-type: image/jpeg");

# html

my $page = query_web("GET /robots.txt HTTP/1.0\r\nhost: $host:$port");
for (qw(/raw /html /diff /history /do/changes /do/all/changes /do/rss /do/atom /do/new /do/more /do/match /do/search)) {
  my $url = quotemeta;
  like($page, qr/^Disallow: $url/m, "Robots are disallowed from $url");
}

$page = query_web("GET / HTTP/1.0\r\nhost: $host:$port");

t/WebComments.t view on Meta::CPAN

In my shelf are books
of imaginary worlds
dusty and unread
EOT

my $content = "comment=" . uri_escape_utf8("```\n$haiku```");
my $length = length($content);

$page = query_web("POST /do/comment/Comments%20on%20Hello HTTP/1.0\r\n"
		  . "host: $host:$port\r\n"
		  . "content-type: application/x-www-form-urlencoded\r\n"
		  . "content-length: $length\r\n"
		  . "\r\n"
		  . $content);
like($page, qr/^HTTP\/1.1 400 Bad Request/, "Token required");
like($page, qr/^Token required/m, "Token required error");

$content = "comment=" . uri_escape_utf8("```\n$haiku```") . "&token=lalala";
$length = length($content);

$page = query_web("POST /do/comment/Comments%20on%20Hello HTTP/1.0\r\n"
		  . "host: $host:$port\r\n"
		  . "content-type: application/x-www-form-urlencoded\r\n"
		  . "content-length: $length\r\n"
		  . "\r\n"
		  . $content);

like($page, qr/^HTTP\/1.1 400 Bad Request/, "Wrong Token");
like($page, qr/^Wrong token/m, "Wrong token error");

$content = "comment=" . uri_escape_utf8("```\n$haiku```") . "&token=hello";
$length = length($content);

$page = query_web("POST /do/comment/Comments%20on%20Hello HTTP/1.0\r\n"
		  . "host: $host:$port\r\n"
		  . "content-type: application/x-www-form-urlencoded\r\n"
		  . "content-length: $length\r\n"
		  . "\r\n"
		  . $content);

like($page, qr/^HTTP\/1.1 302 Found/, "Redirect after save");
like(query_web("GET /page/Comments%20on%20Hello HTTP/1.0\r\nhost: $host:$port"),
     qr/In my shelf are books/, "Page saved");

done_testing;

t/WebEdit.t view on Meta::CPAN

The laptop streaming
videos of floods and rain
but I hear sparrows
EOT

my $content = "text=" . uri_escape_utf8("```\n$haiku```");
my $length = length($content);

$page = query_web("POST /do/edit/Hello HTTP/1.0\r\n"
		  . "host: $host:$port\r\n"
		  . "content-type: application/x-www-form-urlencoded\r\n"
		  . "content-length: $length\r\n"
		  . "\r\n"
		  . $content);
like($page, qr/^HTTP\/1.1 400 Bad Request/, "Token required");
like($page, qr/^Token required/m, "Token required error");

$content = "text=" . uri_escape_utf8("```\n$haiku```") . "&token=lalala";
$length = length($content);

$page = query_web("POST /do/edit/Hello HTTP/1.0\r\n"
		  . "host: $host:$port\r\n"
		  . "content-type: application/x-www-form-urlencoded\r\n"
		  . "content-length: $length\r\n"
		  . "\r\n"
		  . $content);

like($page, qr/^HTTP\/1.1 400 Bad Request/, "Wrong Token");
like($page, qr/^Wrong token/m, "Wrong token error");

$content = "text=" . uri_escape_utf8("```\n$haiku```") . "&token=hello";
$length = length($content);

$page = query_web("POST /do/edit/Hello HTTP/1.0\r\n"
		  . "host: $host:$port\r\n"
		  . "content-type: application/x-www-form-urlencoded\r\n"
		  . "content-length: $length\r\n"
		  . "\r\n"
		  . $content);

like($page, qr/^HTTP\/1.1 302 Found/, "Redirect after save");
like(query_web("GET /page/Hello HTTP/1.0\r\nhost: $host:$port"),
     qr/The laptop streaming/, "Page saved");

done_testing;

t/archive-spaces.t view on Meta::CPAN

   # create a space

   my $sdir = "$dir/berta";
   mkdir($sdir);
   mkdir("$sdir/page");
   write_text("$sdir/page/Berta.gmi", "Berta Basler");
   write_text("$sdir/page/Tanka.gmi", "What a poet!");
   mkdir("$sdir/file");
   write_binary("$sdir/file/berta.jpg", read_binary("t/alex.jpg"));
   mkdir("$sdir/meta");
   write_text("$sdir/meta/berta.jpg", "content-type: image/jpeg");
   write_text("$sdir/index", join("\n", "Tanka", "Berta", ""));
   write_text("$sdir/changes.log",
	      join("\n",
		   join("\x1f", 1593600755, "Berta", 1, 1441),
		   join("\x1f", 1593610755, "berta.jpg", 0, 1441),
		   join("\x1f", 1593620755, "Tanka", 1, 1441),
		   ""));

   # test the berta space

t/archive-spaces.t view on Meta::CPAN

   }

   # redo the main space

   mkdir("$dir/page");
   write_text("$dir/page/Alex.gmi", "Alex Schroeder");
   write_text("$dir/page/Haiku.gmi", "What a poet!");
   mkdir("$dir/file");
   write_binary("$dir/file/alex.jpg", read_binary("t/alex.jpg"));
   mkdir("$dir/meta");
   write_text("$dir/meta/alex.jpg", "content-type: image/jpeg");
   write_text("$dir/index", join("\n", "Haiku", "Alex", ""));
   write_text("$dir/changes.log",
	      join("\n",
		   join("\x1f", 1593600755, "Alex", 1, 1441),
		   join("\x1f", 1593610755, "alex.jpg", 0, 1441),
		   join("\x1f", 1593620755, "Haiku", 1, 1441),
		   ""));

   $page = query_gemini("$base/do/data");
   like($page, qr/^20 application\/tar\r\n/m, "download tar file");

t/archive.t view on Meta::CPAN

   qx'/bin/tar --version' =~ /GNU tar/ or skip "No GNU tar on this system";

   require './t/test.pl';

   mkdir("$dir/page");
   write_text("$dir/page/Alex.gmi", "Alex Schroeder");
   write_text("$dir/page/Haiku.gmi", "What a poet!");
   mkdir("$dir/file");
   write_binary("$dir/file/alex.jpg", read_binary("t/alex.jpg"));
   mkdir("$dir/meta");
   write_text("$dir/meta/alex.jpg", "content-type: image/jpeg");
   write_text("$dir/index", join("\n", "Haiku", "Alex", ""));
   write_text("$dir/changes.log",
	      join("\n",
		   join("\x1f", 1593600755, "Alex", 1, 1441),
		   join("\x1f", 1593610755, "alex.jpg", 0, 1441),
		   join("\x1f", 1593620755, "Haiku", 1, 1441),
		   ""));

   my $page = query_gemini("$base/");
   like($page, qr/^=> $base\/do\/data Download data/m, "main menu contains download link");

t/example-registered-editors-only.t view on Meta::CPAN

Fireworks outside
our national holiday
sounds like a war zone
EOT

my $content = "text=" . uri_escape_utf8("```\n$haiku```");
my $length = length($content);

$page = query_web("POST /do/edit/Test HTTP/1.0\r\n"
		  . "host: $host:$port\r\n"
		  . "content-type: application/x-www-form-urlencoded\r\n"
		  . "content-length: $length\r\n"
		  . "\r\n"
		  . $content);

like($page, qr/^HTTP\/1.1 302 Found/, "Redirect after save");
like(query_web("GET /page/Test HTTP/1.0\r\nhost: $host:$port"),
     qr/Fireworks outside/, "Page saved");

done_testing;

t/spaces.t view on Meta::CPAN


require './t/test.pl';

# set up the main space with some test data

mkdir("$dir/page");
write_text("$dir/page/Alex.gmi", "Alex Schroeder");
mkdir("$dir/file");
write_binary("$dir/file/alex.jpg", read_binary("t/alex.jpg"));
mkdir("$dir/meta");
write_text("$dir/meta/alex.jpg", "content-type: image/jpeg");
write_text("$dir/index", join("\n", "Haiku", "Alex", ""));
write_text("$dir/changes.log",
	   join("\n",
		join("\x1f", 1593600755, "Alex", 1, 1441),
		join("\x1f", 1593610755, "alex.jpg", 0, 1441),
		join("\x1f", 1593620755, "Haiku", 1, 1441),
		""));

# test the main space

t/test.pl view on Meta::CPAN

  return "$header\r\n$buffer";
}

sub query_web {
  my $query = shift;
  my $cert = shift // 1; # suppress use of client certificate in the test
  $query .= "\r\n" unless $query =~ /^POST/; # add empty line for GET requests
  my $response = query_gemini($query, undef, $cert);
  # fixup encoding for two trivial cases of encoding html
  my $header_end = index($response, "\r\n\r\n");
  if (substr($response, 0, $header_end + 2) =~ /content-type: text\/[a-z]+; charset=(\S+)/i
      or substr($response, $header_end + 4) =~ /<meta charset=\"(\S+)\">/i) {
    my $encoding = $1;
    $response = substr($response, 0, $header_end + 4)
	. decode($encoding, substr($response, $header_end + 4));
  }
  return $response;
}

my $total = 0;
my $ok = 0;

( run in 1.321 second using v1.01-cache-2.11-cpan-524268b4103 )