Plan 9 from Bell Labs’s /usr/web/sources/contrib/yk/lab/perl9p/Plan9srv.t

Copyright © 2021 Plan 9 Foundation.
Distributed under the MIT License.
Download the Plan 9 distribution.


package main;
use strict;
use Plan9;		# ./Plan9.pm
use Data::Dumper;
use Config;
use warnings;

use constant {
	Qtop 	=>	0,
	Qtest	=>	1,
	Qconfig	=>	2,
	Qdate	=>	3,
};

my $testname = 'test';	# rename allowed
my $teststr = "test passed\n";	# write allowed
my $testvers = 0;	# write counter

sub fsattach {
	my ($r) = @_;
	my $qid;

	$qid = {
		path=>Qtop,
		vers=>0,
		type=>Plan9::QTDIR,
	};
	$r->{fid}->{qid} = $qid;
	$r->{ofcall}->{qid} = $qid;
	Plan9::respond($r);
}

sub fswalk {
	my ($r) = @_;
	my ($path, @wqid, $fntab, $fn);


	$path = $r->{fid}->{qid}->{path};
	$fntab = {
		&Qtop => {
			$testname =>	sub {
				$path = Qtest;
				push(@wqid, {path=>$path, vers=>$testvers, type=>0});
			},
			'config' =>	sub {
				$path = Qconfig;
				push(@wqid, {path=>$path, vers=>0, type=>0});
			},
			'date' =>    	sub {
				$path = Qdate;
				push(@wqid, {path=>$path, vers=>0, type=>0});
			},
		},
	};

	for(@{$r->{ifcall}->{wname}}){
		if($_ eq '..'){
			$path = Qtop;
			push(@wqid, {path=>$path, vers=>0, type=>Plan9::QTDIR});
			next;
		}
		$fn = $fntab->{$path}->{$_};
		if(!defined $fn or !&$fn()){
			last;
		}
	}
	$r->{ofcall}->{wqid} = \@wqid;
	Plan9::respond($r);
}

sub getstat {
	my ($path) = @_;
	my ($d, $fntab);

	$d = {};
	%{$d} = %Plan9::nulldir;
	$d->{qid} = {path=>$path, vers=>0, type=>0};
	$d->{uid} = $d->{gid} = $d->{muid} = "tester";
	$d->{mode} = 0444;

	$fntab = {
		&Qtop =>  	sub {
			$d->{name} = ".";
			$d->{qid}->{type} = Plan9::QTDIR;
		},
		&Qtest => 	sub {
			$d->{name} = $testname;
			$d->{qid}->{vers} = $testvers;
			$d->{mode} = 0666;
			$d->{length} = length($teststr);
		},
		&Qconfig =>	sub {
			$d->{name} = "config";
		 },
		&Qdate =>	sub {
			$d->{name} = "date";
		},
	};
	&{$fntab->{$path}}();

	if($d->{qid}->{type}&Plan9::QTDIR){
		$d->{mode} |= 0111 | Plan9::DMDIR;
	}
	return $d;
}

sub fsstat {
	my ($r) = @_;

	$r->{d} = getstat($r->{fid}->{qid}->{path});
	Plan9::respond($r);
}

sub fswstat {
	my ($r) = @_;
	my $path;

	$path = $r->{fid}->{qid}->{path};

	if($path != Qtest
	or $r->{d}->{mode} != $Plan9::syncdir{mode}
	or $r->{d}->{uid} ne $Plan9::syncdir{uid}
	or $r->{d}->{gid} ne $Plan9::syncdir{gid}){
		Plan9::respond($r, "permission denied");
		return;
	}
	if($r->{d}->{name} ne $Plan9::syncdir{name}){
		$testname = $r->{d}->{name};
	}
	if($r->{d}->{length} != $Plan9::syncdir{length}){
		$teststr = substr($teststr, 0, $r->{d}->{length});
	}

	Plan9::respond($r);
}

sub fsread {
	my ($r) = @_;
	my ($path, $gen);

	$path = $r->{fid}->{qid}->{path};

	if($path == Qtop){
		$gen = sub {
			return undef unless exists $_[$_];
			return getstat($_[$_]);
		};
		Plan9::dirread9p($r, $gen, Qtest, Qconfig, Qdate);
		Plan9::respond($r);
	}elsif($path == Qtest){
		Plan9::readstr($r, $teststr);
		Plan9::respond($r);
	}elsif($path == Qconfig){
		Plan9::readstr($r, Config::myconfig());
		Plan9::respond($r);
	}elsif($path == Qdate){
		Plan9::readstr($r, `date`);
		Plan9::respond($r);
	}else{
		Plan9::respond($r, "programming error in fsread");
	}
}

sub fswrite {
	my ($r) = @_;
	my ($path, $gen);

	$path = $r->{fid}->{qid}->{path};

	if($path != Qtest){
		Plan9::respond($r, "permission denied");
		return;
	}
	$teststr = $r->{ifcall}->{data};		# offset ignored
	++$testvers;
	$r->{ofcall}->{count} = length($r->{ifcall}->{data});
	Plan9::respond($r);
}

my $srv = {
	ior => \*STDIN,
	iow => \*STDOUT,
	attach => \&fsattach,
	walk => \&fswalk,
	read => \&fsread,
	write => \&fswrite,
	stat => \&fsstat,
	wstat => \&fswstat,
};

$::chatty9p = 1;
Plan9::srv($srv);

# rm -f /srv/p; srv -e 'Perl $%' p /n/local

Bell Labs OSI certified Powered by Plan 9

(Return to Plan 9 Home Page)

Copyright © 2021 Plan 9 Foundation. All Rights Reserved.
Comments to [email protected].