From Newsgroup: comp.lang.perl.misc

I have recently decided to create an MCP server in perl for the purpose
of searching, and getting context from, alternative protocols for agents
to use. Why? Well, certainly it is not for any practical reason, but it
is a funny thing to create.

So far, it fully is able to pull gemini, gopher, and spartan pages, and
can search gopherspace and geminispace competently. The full code is
below, it is meant to be used for Claude Code, as that is what I am
using through ollama, but it most likely can be edited easily.

A copy of the sourcecode exists on
https://codeberg.org/1casie/clover-mcp, and a curl'able bash install
script exists on https://nyet.su/get_clover.sh, though my uptime isn't
the best.

I would love to see if somehow, through the will of this community,
someone could help me create a better version of this that is properly "in-line" with any suggestions? All I know is that I know nothing. All I
know is that it is anachronistic and funny for LLMs to be able to
interract with protocols and content using period-appropriate languages/servers.

```perl
#!/usr/bin/perl
# clover.pl — MCP server for Gopher, Gemini, and Spartan protocols
# Written in Perl because it was alive when Gopher was cool.
# Hand-rolled JSON-RPC over stdio because there's no Perl MCP SDK
(obviously).
#
# https://nyet.su/get_clover.sh
#
# SEARCH ENGINES:
# Gopher: Veronica-2 — gopher://gopher.floodgap.com:70/7/v2/vs
# The one true living Gopher search engine. ~5.1M selectors.
# Gemini: geminispace.info — gemini://geminispace.info/search
# kennedy.gemi.dev — gemini://kennedy.gemi.dev/search
(boolean ops)
# tlgs.one — gemini://tlgs.one/search
# Spartan: AuraSearch — gemini://aurasearch.ddns.net/
# Indexes Gemini, Nex, Spartan, and Scroll. Accessed over Gemini
# because Spartan is too smol to have its own search engine lol.

use strict;
use warnings;
use IO::Socket::INET;
use IO::Socket::SSL;
use JSON qw(encode_json decode_json);
use URI::Escape qw(uri_escape);

$| = 1;

# ─────────────────────────────────────────────────────────────────────────────
# GOPHER CLIENT
# ─────────────────────────────────────────────────────────────────────────────

sub parse_gopher_url {
my ($url) = @_;
if ($url =~
m{^gopher://([^/:]+)(?::(\d+))?(?:/([0-9a-zA-Z+]?)(.*))?$}i) {
return (host=>$1, port=>$2||70, type=>$3//'1', selector=>$4//'');
}
die "Invalid Gopher URL: $url\n";
}

sub fetch_gopher_raw {
my (%args) = @_;
my $sock = IO::Socket::INET->new(
PeerHost => $args{host}, PeerPort => $args{port},
Proto => 'tcp', Timeout => 15,
) or die "Gopher connect failed: $!\n";

my $request = defined $args{query}
? "$args{selector}\t$args{query}"
: $args{selector};

print $sock "$request\r\n";
my $buf = '';
while (my $chunk = <$sock>) { $buf .= $chunk }
close $sock;
return $buf;
}

sub parse_gopher_menu {
my ($raw) = @_;
my @items;
for my $line (split /\r?\n/, $raw) {
last if $line eq '.';
next if $line eq '';
my ($type_and_display, $selector, $host, $port) = split /\t/,
$line, 4;
next unless defined $type_and_display && length $type_and_display;
my $type = substr($type_and_display, 0, 1);
my $display = substr($type_and_display, 1);
$port //= '70'; $port =~ s/\s+$//;
push @items, { type=>$type, display=>$display, selector=>$selector//'', host=>$host//'', port=>$port//70 };
}
return @items;
}

sub gopher_type_name {
my ($t) = @_;
my %types = ('0'=>'TEXT','1'=>'MENU','2'=>'CCSO','3'=>'ERROR','4'=>'BINHEX',

'5'=>'DOS','6'=>'UU','7'=>'SEARCH','8'=>'TELNET','9'=>'BINARY',

'g'=>'GIF','I'=>'IMAGE','h'=>'HTML','i'=>'INFO','s'=>'SOUND');
return $types{$t} // "TYPE($t)";
}

sub fetch_gopher {
my ($url, $max_depth, $current_depth, $visited_ref) = @_;
$max_depth //= 0; $current_depth //= 0; $visited_ref //= {};
return { error=>"Max depth exceeded" } if $current_depth >
$max_depth;
return { error=>"Already visited: $url" } if $visited_ref->{$url}++;

my %p = eval { parse_gopher_url($url) };
return { error=>$@ } if $@;

my $raw = eval { fetch_gopher_raw(%p) };
return { error=>$@ } if $@;

my $result = { url=>$url, type=>$p{type}, depth=>$current_depth };

if ($p{type} =~ /^[17]?$/) {
my @items = parse_gopher_menu($raw);
my (@rendered, @links);
for my $item (@items) {
my $tname = gopher_type_name($item->{type});
if ($item->{type} eq 'i') { push @rendered, " $item->{display}" }
elsif ($item->{type} eq '3') { push @rendered, "[ERROR] $item->{display}" }
else {
my $link = "gopher://$item->{host}:$item->{port}/$item->{type}$item->{selector}";
push @rendered, "[$tname] $item->{display} => $link";
push @links, $link if $item->{type} =~ /^[01]$/;
}
}
$result->{content} = join("\n", @rendered);
$result->{links} = \@links;

if ($current_depth < $max_depth && @links) {
$result->{children} = [
map { fetch_gopher($_, $max_depth, $current_depth+1, $visited_ref) } @links
];
}
} else {
$result->{content} = $raw;
}
return $result;
}

sub render_gopher_tree {
my ($node, $indent) = @_;
$indent //= 0;
my $pad = ' ' x $indent;
my $out = "${pad}=== $node->{url} (depth $node->{depth}) ===\n";
if ($node->{error}) { $out .= "${pad}ERROR: $node->{error}\n" }
elsif ($node->{content}) { $out .= "${pad}$_\n" for split /\n/, $node->{content} }
if ($node->{children}) { $out .= render_gopher_tree($_,
$indent+1) for @{ $node->{children} } }
return $out;
}

# ─────────────────────────────────────────────────────────────────────────────
# GEMINI CLIENT
# ─────────────────────────────────────────────────────────────────────────────

sub parse_gemini_url {
my ($url) = @_;
if ($url =~ m{^gemini://([^/:]+)(?::(\d+))?(/.*)$}i ||
$url =~ m{^gemini://([^/:]+)(?::(\d+))?()$}i) {
return (host=>$1, port=>$2||1965, path=>$3||'/');
}
die "Invalid Gemini URL: $url\n";
}

sub fetch_gemini {
my ($url, $depth) = @_;
$depth //= 0;
return "ERROR: Too many redirects\n" if $depth > 5;

my %p = eval { parse_gemini_url($url) };
return "ERROR: $@" if $@;

my $sock = IO::Socket::SSL->new(
PeerHost=>$p{host}, PeerPort=>$p{port},
SSL_verify_mode=>IO::Socket::SSL::SSL_VERIFY_NONE, Timeout=>15,
) or return "ERROR: Gemini TLS connect failed: " . IO::Socket::SSL::errstr() . "\n";

print $sock "$url\r\n";

my $header = <$sock>; chomp $header; $header =~ s/\r$//;
my ($status, $meta) = $header =~ /^(\d{2})\s+(.*)$/;
unless (defined $status) { close $sock; return "ERROR: Malformed
header: $header\n" }

my $sc = int($status/10);
if ($sc == 3) { close $sock; return fetch_gemini($meta, $depth+1) }
if ($sc != 2) {
close $sock;
my %n = (1=>'INPUT',4=>'TEMP FAIL',5=>'PERM FAIL',6=>'CERT REQUIRED');
return "ERROR: Gemini $status " . ($n{$sc}//'UNKNOWN') . " — $meta\n";
}

my $body = '';
while (my $chunk = <$sock>) { $body .= $chunk }
close $sock;
return "STATUS: $status ($meta)\n\n$body";
}

# ─────────────────────────────────────────────────────────────────────────────
# SPARTAN CLIENT
# ─────────────────────────────────────────────────────────────────────────────

sub parse_spartan_url {
my ($url) = @_;
if ($url =~ m{^spartan://([^/:]+)(?::(\d+))?(/.*)$}i ||
$url =~ m{^spartan://([^/:]+)(?::(\d+))?()$}i) {
return (host=>$1, port=>$2||300, path=>$3||'/');
}
die "Invalid Spartan URL: $url\n";
}

sub fetch_spartan {
my ($url, $body) = @_;
$body //= '';
my %p = eval { parse_spartan_url($url) };
return "ERROR: $@" if $@;

my $sock = IO::Socket::INET->new(
PeerHost=>$p{host}, PeerPort=>$p{port}, Proto=>'tcp', Timeout=>15,
) or return "ERROR: Spartan connect failed: $!\n";

my $len = length($body);
print $sock "$p{host} $p{path} $len\r\n";
print $sock $body if $len > 0;

my $header = <$sock>; chomp $header; $header =~ s/\r$//;
my ($status, $meta) = $header =~ /^(\d)\s+(.*)$/;
unless (defined $status) { close $sock; return "ERROR: Malformed
Spartan response: $header\n" }

if ($status == 3) { close $sock; return fetch_spartan($meta) }
if ($status != 2) { close $sock; return "ERROR: Spartan $status — $meta\n" }

my $resp = '';
while (my $chunk = <$sock>) { $resp .= $chunk }
close $sock;
return "STATUS: $status ($meta)\n\n$resp";
}

# ─────────────────────────────────────────────────────────────────────────────
# SEARCH IMPLEMENTATIONS
# ─────────────────────────────────────────────────────────────────────────────

sub search_gopher {
my ($query, $max_results) = @_;
$max_results //= 30;
my $raw = eval {
fetch_gopher_raw(
host=> 'gopher.floodgap.com',
port=> 70,
type=> '7',
selector=> '/v2/vs',
query=> "$query -m$max_results",
);
};
return "ERROR: $@" if $@;

my @items = parse_gopher_menu($raw);
my (@output, $count);
for my $item (@items) {
next if $item->{type} =~ /^[i3]$/;
my $url = "gopher://$item->{host}:$item->{port}/$item->{type}$item->{selector}";
push @output, "[" . gopher_type_name($item->{type}) . "] $item->{display}\n => $url";
last if ++$count >= $max_results;
}
return scalar(@output)
? "Veronica-2 results for: \"$query\"\n(" . scalar(@output) . " results)\n\n" . join("\n\n", @output)
: "Veronica-2: no results found for \"$query\"";
}

sub search_gemini {
my ($query, $engine) = @_;
$engine //= 'geminispace';
my %engines = (
geminispace => 'gemini://geminispace.info/search',
kennedy => 'gemini://kennedy.gemi.dev/search',
tlgs => 'gemini://tlgs.one/search',
);
my $base = $engines{lc($engine)};
unless ($base) {
return "Unknown engine '$engine'. Available: " . join(', ',
sort keys %engines) . "\n"
. "Tip: kennedy supports boolean ops: \"linux AND kernel
NOT windows\", lang=en\n";
}
my $url = $base . '?' . uri_escape($query);
my $result = fetch_gemini($url);
return "[$engine search] Query: \"$query\"\nURL: $url\n\n$result";
}

sub search_spartan {
my ($query) = @_;
my $url = "gemini://aurasearch.ddns.net/search?" .
uri_escape($query);
my $result = fetch_gemini($url);
if ($result =~ /^ERROR/) {
my $root = fetch_gemini("gemini://aurasearch.ddns.net/");
return "AuraSearch direct query failed.\nError:
$result\n\nAuraSearch root:\n$root";
}
return "AuraSearch (Gemini+Spartan+Nex+Scroll) results for: \"$query\"\n\n$result";
}

# ─────────────────────────────────────────────────────────────────────────────
# MCP JSON-RPC 2.0 OVER STDIO
# ─────────────────────────────────────────────────────────────────────────────

sub mcp_response { encode_json({ jsonrpc=>'2.0', id=>$_[0],
result=>$_[1] }) }
sub mcp_error { encode_json({ jsonrpc=>'2.0', id=>$_[0], error=>{ code=>$_[1], message=>$_[2] } }) }
sub tool_text { { content => [{ type=>'text', text=>$_[0] }] } }

my %TOOLS = (
gopher_fetch => {
description => 'Fetch a Gopher URL. Returns menu items or plain
text. Supports recursive crawling to depth n (max 3).',
inputSchema => { type=>'object', required=>['url'], properties => {
url => { type=>'string', description=>'gopher:// URL' },
depth => { type=>'integer', description=>'Crawl depth
(0=single page, max 3)', default=>0 },
}},
},
gopher_search => {
description => 'Search Gopherspace via Veronica-2 (~5.1M
selectors). Supports AND/OR/NOT, wildcards (*), type filters (-t0 text,
-t1 menus).',
inputSchema => { type=>'object', required=>['query'],
properties => {
query => { type=>'string', description=>'e.g. "linux kernel -t1" or "retro AND bbs"' },
max_results => { type=>'integer', description=>'Max results (default 30)', default=>30 },
}},
},
gemini_fetch => {
description => 'Fetch a Gemini capsule (gemini://). Handles
TLS, TOFU certs, redirects.',
inputSchema => { type=>'object', required=>['url'], properties => {
url => { type=>'string', description=>'gemini:// URL' },
}},
},
gemini_search => {
description => 'Search Geminispace. Engines: "geminispace"
(broadest, default), "kennedy" (boolean + PageRank, lang=en), "tlgs" (independent index).',
inputSchema => { type=>'object', required=>['query'],
properties => {
query => { type=>'string', description=>'Search query' },
engine => { type=>'string', description=>'"geminispace" | "kennedy" | "tlgs"', default=>'geminispace' },
}},
},
spartan_fetch => {
description => 'Fetch a Spartan page (spartan://). No TLS.
Default port 300.',
inputSchema => { type=>'object', required=>['url'], properties => {
url => { type=>'string', description=>'spartan:// URL' },
body => { type=>'string', description=>'Optional body for
input prompts', default=>'' },
}},
},
spartan_search => {
description => 'Search the smol-web (Spartan, Gemini, Nex,
Scroll) via AuraSearch.',
inputSchema => { type=>'object', required=>['query'],
properties => {
query => { type=>'string', description=>'Search query' },
}},
},
);

sub handle_request {
my ($req) = @_;
my $id = $req->{id};
my $method = $req->{method} // '';
my $params = $req->{params} // {};

return mcp_response($id, {
protocolVersion => '2024-11-05',
serverInfo => { name=>'clover', version=>'2.0.0' },
capabilities => { tools=>{} },
}) if $method eq 'initialize';

return undef if $method eq 'notifications/initialized';

if ($method eq 'tools/list') {
return mcp_response($id, { tools => [
map { { name=>$_, description=>$TOOLS{$_}{description}, inputSchema=>$TOOLS{$_}{inputSchema} } }
sort keys %TOOLS
]});
}

if ($method eq 'tools/call') {
my $name = $params->{name} // '';
my $args = $params->{arguments} // {};

if ($name eq 'gopher_fetch') {
my $url = $args->{url} or return mcp_error($id, -32602,
'url required');
my $depth = $args->{depth} // 0; $depth = 3 if $depth > 3;
my $tree = eval { fetch_gopher($url, $depth, 0, {}) };
return mcp_response($id, tool_text($@ ? "ERROR: $@" : render_gopher_tree($tree)));
}
if ($name eq 'gopher_search') {
my $q = $args->{query} or return mcp_error($id, -32602,
'query required');
my $out = eval { search_gopher($q, $args->{max_results}//30) };
return mcp_response($id, tool_text($@ ? "ERROR: $@" : $out));
}
if ($name eq 'gemini_fetch') {
my $url = $args->{url} or return mcp_error($id, -32602,
'url required');
my $out = eval { fetch_gemini($url) };
return mcp_response($id, tool_text($@ ? "ERROR: $@" : $out));
}
if ($name eq 'gemini_search') {
my $q = $args->{query} or return mcp_error($id, -32602,
'query required');
my $out = eval { search_gemini($q, $args->{engine}//'geminispace') };
return mcp_response($id, tool_text($@ ? "ERROR: $@" : $out));
}
if ($name eq 'spartan_fetch') {
my $url = $args->{url} or return mcp_error($id, -32602,
'url required');
my $out = eval { fetch_spartan($url, $args->{body}//'') };
return mcp_response($id, tool_text($@ ? "ERROR: $@" : $out));
}
if ($name eq 'spartan_search') {
my $q = $args->{query} or return mcp_error($id, -32602,
'query required');
my $out = eval { search_spartan($q) };
return mcp_response($id, tool_text($@ ? "ERROR: $@" : $out));
}

return mcp_error($id, -32601, "Unknown tool: $name");
}

return mcp_response($id, {}) if $method eq 'ping';
return mcp_error($id, -32601, "Method not found: $method");
}

while (my $line = <STDIN>) {
chomp $line; next unless $line =~ /\S/;
my $req = eval { decode_json($line) };
if ($@) {
print encode_json({ jsonrpc=>'2.0', id=>undef, error=>{
code=>-32700, message=>"Parse error" } }) . "\n";
next;
}
my $response = handle_request($req);
print $response . "\n" if defined $response;
}
```

-- Casie Nakamura
--- Synchronet 3.21d-Linux NewsLink 1.2