view release on metacpan or  search on metacpan

t/Capsules.t  view on Meta::CPAN

like($page, qr/^61 This is not your space/, "Wrong client certificate");

$page = query_gemini("$base/capsule/login", undef, 0);
like($page, qr/^60 You need a client certificate to access your capsule/, "Login without certificate");

$page = query_gemini("$base/capsule/login");
$page =~ qr/^30 $base\/capsule\/([a-z]+)\r\n/;
is($name, $1, "Login");

$page = query_gemini("$titan/$name/haiku.gmi;size=71;mime=text/plain", $haiku);
like($page, qr/^30 $base\/capsule\/$name/, "Saved haiku");

$page = query_gemini("$base/capsule/$name/haiku.gmi");
is($page, "20 text\/gemini\r\n$haiku", "Read haiku");

$page = query_gemini("$base/capsule/$name");
like($page, qr/^=> $base\/capsule\/$name\/haiku\.gmi haiku\.gmi/m, "List haiku");

# sharing and getting the temporary password

like($page, qr/^=> $base\/capsule\/$name\/share Share access/m, "Share link");

$page = query_gemini("$base/capsule/$name/share", undef, 0);
like($page, qr/^60 You need a client certificate/, "Sharing without certificate");

$page = query_gemini("$base/capsule/$name/share");
like($page, qr/^This password .*: (\S+)$/m, "Temporary password");
$page =~ qr/^This password .*: (\S+)$/m;
my $pwd = $1;
ok($pwd, "Password");

$page = query_gemini("$base/capsule/$name/share", undef, 2);
like($page, qr/^60 You need a different client certificate/, "Sharing with the wrong certificate");

# access using the temporary password

$page = query_gemini("$base/capsule/$name", undef, 2);
like($page, qr/^=> $base\/capsule\/$name\/access Access this capsule/m, "Access offered");

$page = query_gemini("$base/capsule/$name/access");
like($page, qr/^10/m, "Access requires password");

$page = query_gemini("$base/capsule/$name/access?$pwd", undef, 0);
like($page, qr/^60 You need a client certificate/, "Access without certificate");

$page = query_gemini("$base/capsule/$name/access?$pwd");
like($page, qr/^30 $base\/capsule\/$name/m, "Redirect to my own capsule");
ok(! -f "$dir/fingerprint_equivalents", "Fingerprint equivalents unnecessary");

$page = query_gemini("$base/capsule/$name/access?$pwd", undef, 2); # a different certificate
like($page, qr/^30 $base\/capsule\/$name/m, "Redirect to the same capsule");
ok(-f "$dir/fingerprint_equivalents", "Fingerprint equivalents saved");
like(read_text("$dir/fingerprint_equivalents"), qr/^sha256\S+ sha256\S+$/, "Fingerprint equivalents");

# testing the fingerprint equivalency

$page = query_gemini("$base/capsule/$name", undef, 2);
like($page, qr/# $name/mi, "Title");
like($page, qr/^=> $base\/capsule\/$name\/upload/m, "Equivalent upload link");

# test backup
ok(! -d "$dir/capsule/$name/backup", "No backup dir has been created");
ok(! -f "$dir/capsule/$name/backup/haiku.gmi", "No backup has been made");
my $ts = time - 1000;
is(utime($ts, $ts, "$dir/capsule/$name/haiku.gmi"), 1, "File backdated");

$haiku = <<"EOT";
Nervous late at night
Typing furiously, in vain
There's always a bug
EOT

$page = query_gemini("$titan/$name/haiku.gmi;size=69;mime=text/plain", $haiku);
like($page, qr/^30 $base\/capsule\/$name/, "Saved haiku");
ok(-d "$dir/capsule/$name/backup", "Backup dir has been created");
ok(-f "$dir/capsule/$name/backup/haiku.gmi", "Backup has been made");
like(read_text("$dir/capsule/$name/haiku.gmi"), qr/Nervous late at night/, "File saved");
like(read_text("$dir/capsule/$name/backup/haiku.gmi"), qr/On the red sofa/, "Backup saved");
$page = query_gemini("$base/capsule/$name/haiku.gmi");
like($page, qr/Nervous late at night/, "Current page");
$page = query_gemini("$base/capsule/$name/backup/haiku.gmi");
like($page, qr/On the red sofa/, "Backup page");

 SKIP: {
   -x '/bin/tar' or skip "Missing /bin/tar on this system";
   qx'/bin/tar --version' =~ /GNU tar/ or skip "No GNU tar on this system";

   $page = query_gemini("$base/capsule/$name/archive");
   like($page, qr/^20 application\/tar\r\n/m, "Download tar file");

   $page =~ s/^20 application\/tar\r\n//;
   my $tar = read_binary("$dir/capsule/$name/backup/data.tar.gz");
   ok($tar eq $page, "tar bytes are correct");

   open(my $fh, "tar --list --gzip --file $dir/capsule/$name/backup/data.tar.gz |");
   my @files = <$fh>;
   close($fh);
   ok((first { "$name/haiku.gmi\n" } @files), "Found haiku in the archive");
   ok((grep !/backup/, @files), "No backups in the archive (@files)");
}

# upload to the wrong place

$page = query_gemini("$titan/$name;size=69;mime=text/plain", $haiku);
like($page, qr/^59 The titan URL is missing the file name/, "Missing file name");

# Missing extension

$page = query_gemini("$titan/$name/no-extension;size=69;mime=text/plain", $haiku);
like($page, qr/^59 This wiki does not allow application\/octet-stream/, "Missing file extension");

# delete file

$page = query_gemini("$base/capsule/$name");
like($page, qr/delete/, "Deleting files");
like($page, qr/haiku\.gmi/, "File listed");
$page = query_gemini("$base/capsule/$name/delete");
like($page, qr/^# Delete a file in $name/mi, "Deleting page header");
like($page, qr/^=> $base\/capsule\/$name\/delete\/haiku\.gmi/m, "Deleting page menu");
$page = query_gemini("$base/capsule/$name/delete/haiku.gmi");
like($page, qr/^30 $base\/capsule\/$name\r\n/, "Redirect after delete");
$page = query_gemini("$base/capsule/$name");
unlike($page, qr/haiku\.gmi/, "File listed");
$page = query_gemini("$base/capsule/$name/delete");
like($page, qr/^There are no files to delete/m, "No more files to delete");
ok(! -f "$dir/capsule/$name/haiku.gmi", "File is gone");
like(read_text("$dir/capsule/$name/backup/haiku.gmi"), qr/Nervous late at night/, "Backup saved");

done_testing;