#!/usr/bin/perl

use Net::DNS;
use Fuse;
use Data::Dumper;
use POSIX;
use File::Basename;

use strict;
use warnings;

# /NL/ns    ns records for NL
# /NL/NS    delegation for NS

# /NL/MIEK/WWW/	    is www.miek.nl.
# /NL/MIEK/A/a	    is the A record for a.miek.nl 
# /NL/MIEK/A/	    is the delegation for A.MIEK.NL
# /NL/MIEK/a	    is the a record for miek.nl
# /NL/MIEK/www/txt  is the TXT record for the www.miek.nl
# /NL/MIEK/txt/txt  TXT record for txt.miek.nl
# The TTL is encoded in the {a,m}time: correct time + TTL

# When doing a ls (without files) in a directory the
# code will look for @ValidTypes (except any)

# TODO
# AXFR support for getting the names
# correct filesizes
# offset when reading
# CNAME
# dnssec validation (maybe encode it in permissions??)

my @ValidTypes = qw/ns a aaaa txt soa dnskey rrsig ds hinfo any/;

my $Res = Net::DNS::Resolver->new(
    recurse => 1,
    debug   => 0,
);

# for every new name we increment $inode and put the name in the hash
my $inode = 3;
my %inodes;

$inodes{"/"} = 2;   # the root

# Reverse a filename and return it as a DNS name, with dots
sub rev($) {
    join ".", reverse split "/", shift;
}

# Search for a name in the DNS
sub search($$) {
    my ($qname, $qtype) = (shift, shift);
    my @data;
    my $ok = 0;

    foreach my $rr (@ValidTypes) {
	if ($qtype eq $rr) { $ok = 1; }
    }
    if ($ok == 0) { return @data; }

    my $p = $Res->send($qname, $qtype);

    if ($p->header->ancount > 0) {
	foreach my $r ($p->answer) {
	    if ($qtype eq "any") {
		push @data, $r;
	    } else {
		if ($r->type eq uc $qtype) {
		    push @data, $r;
		}
	    }
	}
    }
    @data;
}

sub axfr($) {
    my $zone = shift;
    my @rrs = $Res->axfr($zone);
    return @rrs;
}

sub e_getattr($) {
    my $path = shift;
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
    my ($left, $right);

    $blocks = 1;
    $blksize = 1024;
    $rdev = 1;
    $nlink = 1;
    $size = 512;
    $atime = $ctime = $mtime = time();

    # handle the root as a special case
    if ($path eq "/") {
	$ino = $inodes{$path};
	$size = 4096;
	$nlink = 2;
	$mode = (0040<<9) + 0755;
	return ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
    }

    $left = basename uc $path;
    $right = basename $path;

    # some weird stuff seems to be added by FUSE
    if ($right eq ".git" or $right eq "objects" ) {
	    return -ENOENT();
    }

#    print STDERR "DEBUG ", $path, " ", $left, " ", $right;

    if ($left eq $right) {
	# it is written in uppercase, don't know yet if its a zone-cut or just a label
	my @ns = search rev $path, "ns";
	if (@ns + 0 > 0) {
	    # got an answer
	    $ino = $inodes{$path};
	    if ($ino == 0) {
		$inode++;
		$inodes{$path} = $inode;
		$ino = $inode;
	    }
	    # make it a directory
	    $size = 4096;
	    $nlink = 2;
	    $atime += $ns[0]->ttl;	# TTL in date
	    $mtime += $ns[0]->ttl;	# TTL in date
	    $mode = (0040<<9) + 0755;
	    return ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
	} else {
	    # nothing returned, not a zone-cut, maybe only a name
	    # need to encode it is a label
	    my @any = search rev $path, "any";

	    if (@any + 0 > 0) {
		$ino = $inodes{$path};
		if ($ino == 0) {
		    $inode++;
		    $inodes{$path} = $inode;
		    $ino = $inode;
		}
#		$size = 4096; need to calculate the correct size
		$atime += $any[0]->ttl;	# TTL in date
		$mtime += $any[0]->ttl;	# TTL in date
		$mode = (0040<<9) + 0755;
		return ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
	    } else {
		return -ENOENT();
	    }
	}
    }

    $left = basename lc $path;
    $right = basename $path;
    if ($left eq $right) {
	# it is a lowercase path, it is a resource record
	my $zone = rev $path;
	$zone =~ s/^$right\.//;
	my @any = search $zone, $right;

	if (@any + 0 > 0) {
	    $ino = $inodes{$path};
	    if ($ino == 0) {
		$inode++;
		$inodes{$path} = $inode;
		$ino = $inode;
	    }
	    $size = 512;
	    $mode = (0100<<9) + 0644;
	    $atime += $any[0]->ttl;	# TTL in date
	    $mtime += $any[0]->ttl;	# TTL in date
	    return ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
	} else {
	    # nothing returned, not a label
	    return -ENOENT();
	}
    }

    return -ENOENT();
}

sub e_open($$) {
    my ($path, $flags) = (shift, shift);

    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = e_getattr($path);
    if ($blocks == -ENOENT()) { return -ENOENT(); }
    if (S_ISDIR $mode) { return -EISDIR(); }
    return 0;
}


sub e_read($$$) {
    my ($path, $qsize, $offset) = (shift, shift, shift);

    if (e_getattr($path) == -ENOENT()) {
	return -ENOENT();
    }

    my $qtype = basename $path;
    my $zone = rev $path;
    $zone =~ s/^$qtype\.//;
    my @c = search $zone, $qtype;

    my $content;
    if (@c + 0 > 0) {
	# found something
	foreach my $c (@c) {
	    $content .= $c->string . "\n";
	}
    }
    return $content;
}

sub e_getdir($) {
    my $path = shift;
    my @files;

    foreach my $rr (@ValidTypes) {
	if ($rr eq "any") { next; }
	my @data =  search rev $path, $rr;
	if (@data + 0 > 0) {
	    # positive answer
	    push @files, lc $data[0]->type;
	}
    }
    return @files,0;
}

sub e_statfs { return 255, 1, 1, 1, 1, 2 }

# If you run the script directly, it will run fusermount, which will in turn
# re-run this script.  Hence the funky semantics.
my $mountpoint;
$mountpoint = shift(@ARGV) if @ARGV;
Fuse::main(
    debug 	=> 0,
    mountpoint	=> $mountpoint,
    getattr 	=> "main::e_getattr",
    getdir 	=> "main::e_getdir",
    open   	=> "main::e_open",
    read  	=> "main::e_read",
    statfs 	=> "main::e_statfs",
#    unlink	=> ,
#    readlink	=> ,
#    write	=> ,
    threaded	=> 0,
);