#!/usr/bin/perl
package Fcall;
use strict;
use constant VERSION9P	=> '9P2000';
use constant MAXWELEM	=> 16;
use constant IOHDRSZ	=> 24;
use constant NOTAG		=> 0xffff;
use constant NOFID		=> 0xffffffff;
use constant STATFIXLEN => (2+13+5*2+4*4+8);
use constant
{
	Tversion	=> 100,
	Rversion	=> 101,
	Tauth	=> 102,
	Rauth	=> 103,
	Tattach	=> 104,
	Rattach	=> 105,
	Terror	=> 106, # illegal
	Rerror	=> 107,
	Tflush	=> 108,
	Rflush	=> 109,
	Twalk	=> 110,
	Rwalk	=> 111,
	Topen	=> 112,
	Ropen	=> 113,
	Tcreate	=> 114,
	Rcreate	=> 115,
	Tread	=> 116,
	Rread	=> 117,
	Twrite	=> 118,
	Rwrite	=> 119,
	Tclunk	=> 120,
	Rclunk	=> 121,
	Tremove	=> 122,
	Rremove	=> 123,
	Tstat	=> 124,
	Rstat	=> 125,
	Twstat	=> 126,
	Rwstat	=> 127,
	Tmax	=> 128,
};

sub	getfcall($$\%);
sub	getstat($\%);
sub	putfcall(\%);
sub	putstat(\%);
sub	read9pmsg(*;$);
use	Symbol	'qualify_to_ref';

use constant
{
	QTDIR		=> 0x80,
	QTAPPEND	=> 0x40,
	QTEXCL		=> 0x20,
	QTMOUNT	=> 0x10,
	QTAUTH		=> 0x08,
	QTTMP		=> 0x04,
	QTFILE		=> 0x00,
};

sub	fcallfmt(\%);
sub	statfmt(\%);
sub	qidfmt(\%);
sub	qidtype($);

sub
getfcall($$\%)
{
	my ($ap, $nap, $f) = @_;
	my ($p, $size, %stat, %qid);

	%{$f} = ();
	return undef if $nap <= 7;
	$size = unpack("V", $ap);
	return undef if $size < 7 or $size > $nap;

	(undef, $f->{type}, $f->{tag}, $p) = unpack("VCva*", $ap);

	for($f->{type}){
		$_==Tversion		&& do {
			@{$f}{'msize','version'} = unpack("Vv/a", $p);
			last;
		};
		$_==Rversion		&& do {
			@{$f}{'msize','version'} = unpack("Vv/a", $p);
			last;
		};
		$_==Tauth		&& do {
			@{$f}{'afid','uname','aname'} = unpack("Vv/av/a", $p);
			last;
		};
		$_==Rauth		&& do {
			${$f}{aqid} = getqid($p, %qid);
			last;
		};
		$_==Rerror		&& do {
			${$f}{ename} = unpack("v/a", $p);
			last;
		};
		$_==Tflush		&& do {
			${$f}{oldtag} = unpack("v", $p);
			last;
		};
		$_==Rflush		&& do {
			last;
		};
		$_==Tattach		&& do {
			@{$f}{'fid','afid','uname','aname'} = unpack("VVv/av/a", $p);
			last;
		};
		$_==Rattach		&& do {
			${$f}{qid} = getqid($p, %qid);
			last;
		};
		$_==Twalk		&& do {
			@{$f}{'fid','newfid','nwname'} = unpack("VVv", $p);
			if(${$f}{nwname} > MAXWELEM){
				$! = 17;	# ENAMETOOLONG
				return undef;
			}
			${$f}{wname} = [];
			(undef, undef, @{$f->{wname}})=
				unpack("VVv" . "v/a"x$f->{nwname}, $p);
			last;
		};
		$_==Rwalk		&& do {
			${$f}{nwqid} = unpack("v", $p);
			if($f->{nwqid} > MAXWELEM){
				$! = 17;	# ENAMETOOLONG
				return undef;
			}
			${$f}{wqid} = [];
			(undef, @{$f->{wqid}}) = unpack("v" . "a[13]"x${$f}{nwqid}, $p);
			foreach(@{$f->{wqid}}){
				my %wqid;
				$_ = getqid($_, %wqid);
			}
			last;
		};
		$_==Topen		&& do {
			@{$f}{'fid','mode'} = unpack("VC", $p);
			last;
		};
		$_==Ropen		&& do {
			@{$f}{'qid','iounit'} = unpack("a[13]V", $p);
			${$f}{qid} = getqid(${$f}{qid}, %qid);
			last;
		};
		$_==Tcreate		&& do {
			@{$f}{'fid','name','perm','mode'} = unpack("Vv/aVC", $p);
			last;
		};
		$_==Rcreate		&& do {
			@{$f}{'qid', 'iounit'} = unpack("a[13]V", $p);
			${$f}{qid} = getqid(${$f}{qid}, %qid);
			last;
		};
		$_==Tread		&& do {
			@{$f}{'fid','offset','count'} = unpack("Va[8]V", $p);
			${$f}{offset} = getvlong(${$f}{offset});
			last;
		};
		$_==Rread		&& do {
			@{$f}{'count','data'} = unpack("VX[V]V/a", $p);
			last;
		};
		$_==Twrite		&& do {
			@{$f}{'fid','offset','count','data'} = unpack("Va[8]VX[V]V/a", $p);
			${$f}{offset} = getvlong(${$f}{offset});
			last;
		};
		$_==Rwrite		&& do {
			${$f}{count} = unpack("V", $p);
			last;
		};
		$_==Tclunk		&& do {
			${$f}{fid} = unpack("V", $p);
			last;
		};
		$_==Rclunk		&& do {
			last;
		};
		$_==Tremove		&& do {
			${$f}{fid} = unpack("V", $p);
			last;
		};
		$_==Rremove		&& do {
			last;
		};
		$_==Tstat		&& do {
			${$f}{fid} = unpack("V", $p);
			last;
		};
		$_==Rstat		&& do {
			${$f}{stat} = getstat(unpack("v/a*", $p), %stat);
			last;
		};
		$_==Twstat		&& do {
			@{$f}{'fid','stat'} = unpack("Vv/a*", $p);
			${$f}{stat} = getstat(${$f}{stat}, %stat);
			last;
		};
		$_==Rwstat		&& do {
			last;
		};
		default: {
			$! = 12;	# EINVAL
			return undef;
		}
	}
	return $size;
}

sub
putfcall(\%)
{
	my ($f) = @_;
	my ($size, $ap, $p, $m, %qid);

	for(${$f}{type}){
		$_==Tversion		&& do {
			$p = pack("Vv/a*", @{$f}{'msize','version'});
			last;
		};
		$_==Rversion		&& do {
			$p = pack("Vv/a*", @{$f}{'msize','version'});
			last;
		};
		$_==Tauth		&& do {
			$p = pack("Vv/a*v/a*", @{$f}{'afid','uname','aname'});
			last;
		};
		$_==Rauth		&& do {
			$p = putqid(%{$f->{aqid}});
			last;
		};
		$_==Rerror		&& do {
			$p = pack("v/a*", ${$f}{ename});
			last;
		};
		$_==Tflush		&& do {
			$p = pack("v", ${$f}{oldsize});
			last;
		};
		$_==Rflush		&& do {
			$p = '';
			last;
		};
		$_==Tattach		&& do {
			$p = pack("VVv/a*v/a*", @{$f}{qw(fid afid uname aname)});
			last;
		};
		$_==Rattach		&& do {
			$p = packQid(%{$f->{qid}});
			last;
		};
		$_==Twalk		&& do {
			$p = pack("VVv", @{$f}{'fid','newfid'},scalar @{$f->{wname}});
			$p .= pack("v/a*", $_) foreach(@{$f->{wname}});
			last;
		};
		$_==Rwalk		&& do {
			$p = pack("v", scalar @{${$f}{wqid}});
			$p .= putqid(%{$_}) foreach @{${$f}{wqid}};
			last;
		};
		$_==Topen		&& do {
			$p = pack("VC", @{$f}{'fid','mode'});
			last;
		};
		$_==Ropen		&& do {
			$p = pack("a[13]V", @{$f}{'qid', 'iounit'});
			last;
		};
		$_==Tcreate		&& do {
			$p = pack("Vv/a*VC", @{$f}{'fid','name','perm','mode'});
			last;
		};
		$_==Rcreate		&& do {
			$p = pack("a[13]V", packQid(%{$f->{qid}}), $f->{iounit});
			last;
		};
		$_==Tread		&& do {
			$m = putvlong(${$f}{offset});
			$p = pack("Va[8]V", $f->{fid}, $m, $f->{count});
			last;
		};
		$_==Rread		&& do {
			$p = pack("V/a*",@{$f}{'data'});
			last;
		};
		$_==Twrite		&& do {
			$m = putvlong(${$f}{offset});
			$p = pack("Va[8]V/a*", ${$f}{fid}, $m, ${$f}{data});
			last;
		};
		$_==Rwrite		&& do {
			$p = pack("V", ${$f}{count});
			last;
		};
		$_==Tclunk		&& do {
			$p = pack("V", ${$f}{fid});
			last;
		};
		$_==Rclunk		&& do {
			$p = '';
			last;
		};
		$_==Tremove		&& do {
			$p = pack("V",  ${$f}{fid});
			last;
		};
		$_==Rremove		&& do {
			$p = '';
			last;
		};
		$_==Tstat		&& do {
			$p = pack("V", ${$f}{fid});
			last;
		};
		$_==Rstat		&& do {
			$p = pack("v/a*", putstat(%{$f->{stat}}));
			last;
		};
		$_==Twstat		&& do {
			$p = pack("Vv/a*", ${$f}{fid}, putstat(%{$f->{stat}}));
			last;
		};
		$_==Rwstat		&& do {
			$p = '';
			last;
		};
		default: {
			$! = 12;	# EINVAL;
			return undef;
		}
	}
	$size = 7+length($p);
	$ap = pack("VCv", $size, @{$f}{'type', 'tag'});
	return $ap.$p;
}

sub
getstat($\%)
{
	my $m = shift;
	my $d = shift;
	my $size;
	my %qid;

	($size, @{$d}{qw(type dev _qid mode atime mtime _length name uid gid muid)})=
		unpack("vvVa[13]VVVa[8]v/a*v/a*v/a*v/a*", $m);
	$d->{length} = getvlong($d->{_length});
	$d->{qid} = getqid($d->{_qid}, %qid);
	delete $d->{_length};
	delete $d->{_qid};
	return $d;
}

sub
putstat(\%)
{
	my $d = shift;
	my $len;

	$d->{_length} = putvlong($d->{length});
	$d->{_qid} = putqid(%{$d->{qid}});
	$len = pack("vVa[13]VVVa[8]v/a*v/a*v/a*v/a*",
		@{$d}{qw(type dev _qid mode atime mtime _length name uid gid muid)});
	delete $d->{_length};
	delete $d->{_qid};
	return $len;
}

sub
putqid(\%)
{
	local $_ = shift;

	return pack("CVa[8]", @{$_}{'type', 'vers', 'path'});
}

sub
getqid($\%)
{
	my $m = shift;
	local $_ = shift;

	@{$_}{'type', 'vers', 'path'} = unpack("CVa[8]", $m);
	return $_;
}

sub
putvlong
{
	local ($_) = @_;
	my ($lo, $hi);

	$lo = $_ & 0xffffffff;
	$hi = ($_ >> 32) & 0xffffffff;
	return pack("VV", $lo, $hi);
}

sub
getvlong
{
	my ($lo, $hi);

	($lo, $hi) = unpack("VV", $_[0]);
	return ($hi << 32) | $lo;
}

sub
qidtype($)
{
	my $t = shift;
	my $s = '';

	$s .= 'd' if($t & QTDIR);
	$s .= 'a' if($t & QTAPPEND);
	$s .= 'l' if($t & QTEXCL);
	$s .= 'M' if($t & QTMOUNT);
	$s .= 'A' if($t & QTAUTH);
	$s .= 't' if($t & QTTMP);
	return $s;
}

sub
fcallfmt(\%)
{
	my $f = shift;
	my ($i, $s, $nwname, $nwqid);
	local $_;

	for(${$f}{type}){
		$_==Tversion 	&& do {
			$s = sprintf("Tversion tag %u msize %u version '%s'",
				@{$f}{'tag','msize','version'});
			last;
		};
		$_==Rversion 	&& do {
			$s = sprintf("Rversion tag %u msize %u version '%s'",
				@{$f}{'tag','msize','version'});
			last;
		};
		$_==Tauth		&& do {
			$s = sprintf("Tauth tag %u afid %d uname %s aname %s",
				@{$f}{'tag','afid','uname','aname'});
			last;
		};
		$_==Rauth		&& do {
			$s = sprintf("Rauth tag %u aqid %s", ${$f}{tag}), qidfmt(%{$f->{aqid}});
			last;
		};
		$_==Rerror		&& do {
			$s = sprintf("Rerror tag %u ename '%s'", @{$f}{'tag','ename'});
			last;
		};
		$_==Tflush		&& do {
			$s = sprintf("Tflush tag %u oldtag %u", @{$f}{'tag','oldtag'});
			last;
		};
		$_==Rflush		&& do {
			$s = sprintf("Rflush tag %u", ${$f}{'tag'});
			last;
		};
		$_==Tattach		&& do {
			$s = sprintf("Tattach tag %u fid %d afid %d uname '%s' aname '%s'",
				@{$f}{'tag','fid', 'afid','uname','aname'});
			last;
		};
		$_==Rattach		&& do {
			$s = sprintf("Rattach tag %u qid %s", ${$f}{tag}, qidfmt(%{$f->{qid}}));
			last;
		};
		$_==Twalk		&& do {
			$nwname = exists($f->{nwname})? $f->{nwname} : @{$f->{wname}};
			$s = sprintf("Twalk tag %u fid %d newfid %d nwname %d",
				@{$f}{'tag','fid', 'newfid'}, $nwname);
			if($nwname <= MAXWELEM){
				for($i=0; $i<$nwname; $i++){
					$s .= sprintf(" %d:%s", $i, $f->{wname}[$i]);
				}
			}
			last;
		};
		$_==Rwalk		&& do {
			$nwqid = exists($f->{nwqid})? $f->{nwqid} : @{$f->{wqid}};
			$s = sprintf("Rwalk tag %u nwqid %d", ${$f}{tag}, $nwqid);
			if($nwqid <= MAXWELEM){
				for($i=0; $i<$nwqid; $i++){
					$s .= sprintf(" %d:%s", $i, qidfmt(%{$f->{wqid}[$i]}));
				}
			}
			last;
		};
		$_==Topen		&& do {
			$s = sprintf("Topen tag %u fid %d mode %d", @{$f}{'tag', 'fid', 'mode'});
			last;
		};
		$_==Ropen		&& do {
			$s = sprintf("Ropen tag %u qid %s iounit %u",
				${$f}{tag}, qidfmt(%{${$f}{qid}}), ${$f}{iounit});
			last;
		};
		$_==Tcreate		&& do {
			$s = sprintf("Tcreate tag %u fid %d name %s perm %o mode %d",
				@{$f}{'tag','fid','name','perm','mode'});
			last;
		};
		$_==Rcreate		&& do {
			$s = sprintf("Rcreate tag %u qid %s iounit %u",
				${$f}{tag}, qidfmt(%{${$f}{qid}}), ${$f}{iounit});
			last;
		};
		$_==Tread		&& do {
			$s = sprintf("Tread tag %u fid %d offset %lld count %u",
				@{$f}{'tag','fid','offset','count'});
			last;
		};
		$_==Rread		&& do {
			$s = sprintf("Rread tag %u count %u ", @{$f}{'tag','count'});
			$s .= "...";	# XXX dumpsome(\$f->{data})
			last;
		};
		$_==Twrite		&& do {
			$s = sprintf("Twrite tag %u fid %d offset %lld count %u ",
				@{$f}{'tag','fid','offset','count'});
			$s .= "...";	# XXX dumpsome(\$f->{data})
			last;
		};
		$_==Rwrite		&& do {
			$s = sprintf("Rwrite tag %u count %u", @{$f}{'tag','count'});
			last;
		};
		$_==Tclunk		&& do {
			$s = sprintf("Tclunk tag %u fid %d", @{$f}{'tag','fid'});
			last;
		};
		$_==Rclunk		&& do {
			$s = sprintf("Rclunk tag %u", ${$f}{tag});
			last;
		};
		$_==Tremove		&& do {
			$s = sprintf("Tremove tag %u fid %d", @{$f}{'tag','fid'});
			last;
		};
		$_==Rremove		&& do {
			$s = sprintf("Rremove tag %u", ${$f}{tag});
			last;
		};
		$_==Tstat		&& do {
			$s = sprintf("Tstat tag %u fid %d", @{$f}{'tag','fid'});
			last;
		};
		$_==Rstat		&& do {
			$s = sprintf("Rstat tag %u %s", ${$f}{tag}, statfmt(%{${$f}{stat}}));
			last;
		};
		$_==Twstat		&& do {
			$s = sprintf("Twstat tag %u %s", ${$f}{tag}, statfmt(%{${$f}{wstat}}));
			last;
		};
		$_==Rwstat		&& do {
			$s = sprintf("Rwstat tag %u", ${$f}{tag});
			last;
		};
		$s = sprintf("unknown type %d", $_);
	}
	return $s;
}

sub
statfmt(\%)
{
	my $d = shift;
	my $s = '';

	return sprintf("'%s' '%s' '%s' '%s' q %s m %lo at %ld mt %ld l %lld t %d d %d",
		@{$d}{qw(name uid gid muid)}, qidfmt(%{${$d}{qid}}),
		@{$d}{qw(mode atime mtime length type dev)});
}

sub
qidfmt(\%)
{
	local $_ = shift;
	my $t;

	$t = qidtype(${$_}{type});
	return sprintf("(%.16llx %lu %s)", @{$_}{'path', 'vers'}, $t);
}


sub read9pmsg(*;$) {
	my $f = qualify_to_ref(shift, caller);
	my ($n) = @_;
	my ($m, $len, $buf1, $buf2);

	$m = read($f, $buf1, 4);
	return undef unless defined $m and $m==4;
	$len = unpack("V", $buf1);
	if($len < 4 or $len > $n) {
		print STDERR "read9pmsg: bad length in 9P2000 message header\n";
		return undef;
	}
	$len -= 4;
	$m = read($f, $buf2, $len);
	return '' if($m < $len);
	return $buf1.$buf2;
}


package client9p;
use Symbol 'qualify_to_ref';

sub	fsinit(*);
sub	fsrpc($;\%\%);
sub	fsrversion($;$$);

sub
fsinit(*)
{
	my $f = qualify_to_ref(shift, caller);
	my %fs;

	$fs{iof} = $f;
	
	fsrversion(\%fs, 8192, Fcall::VERSION9P);

	return \%fs;
}

sub
fsrversion($;$$)
{
	my $fs = shift;
	my $msize = shift;
	my $version = shift;
	my (%t, %r);

	$t{type} = Fcall::Tversion;
	$t{tag} = Fcall::NOTAG;
	$t{version} = $version;
	$t{msize} = $msize;

	$fs->{msize} = $msize;
	fsrpc($fs, %t, %r);

	$r{type} == Fcall::Rversion
		or die "bad version response";
	if($r{msize} < $fs->{msize}){
		$fs->{msize} = $r{msize};
	}
	$fs->{version} = $r{version};
}

sub
fsrpc($;\%\%)
{
	my $fs = shift;
	my ($t, $r) = @_;
	my ($ta, $ra);

	if($::chatty9pclient){
		printf("-> %s\n", Fcall::fcallfmt(%{$t}));
	}
	$ta = Fcall::putfcall(%{$t});			defined $ta
		or die "putfcall failed: $!";
	syswrite($fs->{iof}, $ta, length($ta))
		or die "send failed: $!";
	$ra = Fcall::read9pmsg($fs->{iof}, $fs->{msize});	defined $ra
		or die "reply read failed: $!";
	Fcall::getfcall($ra, $fs->{msize}, %{$r})
		or die "bad 9P reply: $!";
	if($::chatty9pclient){
		printf("<- %s\n", Fcall::fcallfmt(%{$r}));
	}
}

package main;
use strict;
use Socket;
use Data::Dumper;
#BEGIN {
#	$main::{Tversion} = \&{"Fcall::Tversion"};
#}

#$ENV{NAMESPACE} = "/tmp/ns.$ENV{USER}.$ENV{DISPLAY}"
#	unless defined $ENV{NAMESPACE};
#my $conn = "$ENV{NAMESPACE}/factotum";
#socket(S9, PF_UNIX, SOCK_STREAM, 0) or die "socket: $!";
#connect(S9, sockaddr_un($conn)) or die "connect: $!";
open(S9, "</srv/rrr")	or die "open /srv/rrr: $!";

my (%t, %r);
my $fs;

$::chatty9pclient = 1;

$fs = client9p::fsinit(S9);

%t = ();
@t{qw(type tag fid afid uname aname)} = 
	(Fcall::Tattach, 1, 0, Fcall::NOFID, 'user1', '');
client9p::fsrpc($fs, %t, %r);

%t = ();
@t{qw(type tag fid newfid wname)} = (Fcall::Twalk, 2, 0, 1, ['..']);
client9p::fsrpc($fs, %t, %r);

%t = ();
@t{qw(type tag fid)} = (Fcall::Tstat, 3, 1);
client9p::fsrpc($fs, %t, %r);

%t = ();
@t{qw(type tag fid)} = (Fcall::Tclunk, 4, 1);
client9p::fsrpc($fs, %t, %r);

%t = ();
@t{qw(type tag fid)} = (Fcall::Tclunk, 5, 0);
client9p::fsrpc($fs, %t, %r);