#ifndef WYRM_URI_H
#define WYRM_URI_H

	//	wyrm-uri.dna - Copyright (C) 2002 SM Ryan.  All rights reserved.

	#include "wyrmwif.h"

	<wyrm_uriGet declaration>
	<wyrm_uriGetAll declaration>
	<wyrm_uriPut declaration>
	<wyrm_uriPutList declaration>
	<wyrm_uriRemove declaration>
	<wyrm_uriAbsolutise declaration>
	<wyrm_urispace declaration>
	<wyrm_uriMethod declaration>

#endif

		

static const char COPYRIGHT[] = "wyrm-uri.dna - Copyright (C) 2002 SM Ryan.  All rights reserved.";

#include "wyrm-uri.h"
#include "wyrm-io.h"
#include "wyrm-assoc.h"
#include "wyrm-oav.h"
static
#include "wyrm-urispace.h"


#include <ctype.h>
#include <stdlib.h>
#include <stdio.h>

typedef struct Part Part,*pPart,*Parts;

<Forward declarations>
<OAV space>
<Convert protected string to escapes>
<Convert escapes to raw string>
<Parts>
<Make the path canonical>
<Get part of a URI>
<Get all parts of a URI>
<Convert from a Macintosh file join compatiable path list>
<Convert from a Unix file join compatiable path list>
<Put a part into a URI>
<Put a list of parts into a URI>
<Remove a part from a URI>
<Select and evaluate a URI method>
<Absolutise a URI from a base URI>
<URI command>
<Define the URI command to the interpretter>
<uriassist (1WY)>
			
		

static int uriCommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	chars opc;
	Obj op,uri,r;
	int rc = TCL_OK;
	Tcl_ResetResult(intr);
	if (N<2) {usage:
		Tcl_AppendResult(intr,"usage: uri <operation> <uri> ...",0);
		return TCL_ERROR;
	}
	P++; N--;
	opc = Tcl_GetStringFromObj(op=*P++,0); N--;
	if (!streq(opc,"space")) {
		if (N<=0) goto usage;
		uri = *P++; N--;
	}
	if (streq(opc,"base")) {
		if (N!=1) {
			Tcl_AppendResult(intr,"usage: uri base <relative uri> <base uri>",0);
			return TCL_ERROR;
		}
		r = wyrm_uriAbsolutise(intr,uri,*P);
		if (r) Tcl_SetObjResult(intr,r); else rc = TCL_ERROR;
		decr(r);
	}else if (streq(opc,"space")) {
		if (N>1) {
			Tcl_AppendResult(intr,"usage: uri space [<mapping>]",0);
			return TCL_ERROR;
		}
		Tcl_SetObjResult(intr,wyrm_urispace(intr,N==0?0:*P));
	}else if (streq(opc,"part")) {
		switch (N) {
			case 0:		r = wyrm_uriGetAll(intr,uri); break;
			case 1:		r = wyrm_uriGet(intr,uri,Tcl_GetStringFromObj(P[0],0)); break;
			case 2:		r = wyrm_uriPut(intr,uri,Tcl_GetStringFromObj(P[0],0),P[1]); break;
			default:	r = wyrm_uriPutList(intr,uri,N,(Obj*)P); break;
		}
		if (r) Tcl_SetObjResult(intr,r); else rc = TCL_ERROR;
		decr(r);
	}else if (streq(opc,"remove")) {
		if (N==0) {
			Tcl_AppendResult(intr,"usage: uri remove <uri> <part>...",0);
			return TCL_ERROR;
		}
		incr(uri);
		while (N>0) {
			r = wyrm_uriRemove(intr,uri,Tcl_GetStringFromObj(*P,0)); P++; N--;
			decr(uri); uri = r;
		}
		Tcl_SetObjResult(intr,r); decr(r);
	}else {
		rc = wyrm_uriMethod(intr,uri,opc,N,(Obj*)P);
	}
	return rc;
}

		

static int uriCommand(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]);

		

int Wyrmuri_Init(Intr intr) {
	Tcl_PkgProvide(intr,"wyrmuri",VERSION);
	Tcl_PkgRequire(intr,"wyrmwif","1",0);
	Tcl_PkgRequire(intr,"wyrmassoc","1",0);
	Tcl_CreateObjCommand(intr,"::wyrm::uri",uriCommand,0,0);
	Tcl_CreateObjCommand(intr,"::wyrm::uriassist",uriassist,0,0);
	if (Tcl_VarEval(intr,
		"proc ::wyrm::wif::protocol {/line/ /vars/ /script/} {\n",
			"foreach {/var/ /val/} ${/vars/} {set ${/var/} ${/val/}}\n",
			"set line ${/line/}\n",
			"set /rc/ [catch ${/script/} /rs/]\n",
			"set /result/ [list ${/rc/} ${/rs/}]"
			"foreach {/var/ /val/} ${/vars/} {lappend /result/ ${/var/} [set ${/var/}]}\n",
			"return ${/result/}\n",
		"}\n",
	0)!=TCL_OK) return TCL_ERROR;
			
	staticUriSpace();
	return Tcl_VarEval(intr,
			"namespace eval ::wyrm {namespace export uri}\n",
			"namespace eval ::wyrm::wif {variable urispace /%static/urispace.map}\n",
			0);
}
int Wyrmuri_SafeInit(Intr intr) {
	return rprintf(intr,"%!package not available in a safe interpretter",TCL_ERROR);
}

		

int Wyrmuri_Init(Intr intr);
int Wyrmuri_SafeInit(Intr intr);

		

Obj wyrm_uriGet(Intr intr,Obj uri,chars part) {
	Parts parts = parseURI(intr,uri),gotten; Obj R;
	if (!parts) return 0;
	if (streq(part,"PATH") || strieq(part,"macintosh") || strieq(part,"unix")) {
		<Get file join compatiable path list>
	}else {
		gotten = getPart(parts,part);
		if (!gotten) {
			rprintf(intr,"unknown part: %s",part); R = 0;
		}else if (gotten->value) {
			R = incr(Tcl_NewStringObj(gotten->value,gotten->length));
		}else {
			rprintf(intr,"missing: %s",part); R = 0;
		}
		if (streq(part,"path")) R = canonicalPath(R);
	}
	while (parts) {
		parts = deletePart(parts);
	}
	return R;
}

		

Obj wyrm_uriGet(Intr intr,Obj uri,chars part);

Obj wyrm_uriGetAll(Intr intr,Obj uri) {
	Parts parts = parseURI(intr,uri); Obj R;
	if (!parts) return 0;
	R = incr(Tcl_NewObj());
	while (parts) {
		if (parts->value) {
			Obj name,value;
			deescapePart(parts);
			name = Tcl_NewStringObj(parts->name,-1);
			value = incr(Tcl_NewStringObj(parts->value,parts->length));
			if (streq(parts->name,"path")) value = canonicalPath(value);
			if (Tcl_ListObjAppendElement(intr,R,name)!=TCL_OK
					|| Tcl_ListObjAppendElement(intr,R,value)!=TCL_OK)
			{
				decr(value); decr(R); R = 0; break;
			}
			decr(value);
		}
		parts = deletePart(parts);
	}
	while (parts) parts = deletePart(parts);
	return R;
}

		

Obj wyrm_uriGetAll(Intr intr,Obj uri);

Obj wyrm_uriPut(Intr intr,Obj uri,chars part,Obj newpart) {
	Parts parts = parseURI(intr,uri); Obj cpart = 0, R = 0; char state = 'D';
	incr(newpart);
	if (streq(part,"macintosh")) {
		Obj X = convertMacintosh(intr,newpart);
		if (X) {
			decr(newpart); newpart = X;
			part = "path"; state = 'E';
		}
	}else if (streq(part,"PATH") || strieq(part,"unix")) {
		Obj X = convertUnix(intr,newpart);
		if (X) {
			decr(newpart); newpart = X;
			part = "path"; state = 'E';
		}
	}
	cpart = streq(part,"path") ? canonicalPath(newpart) : newpart;
	if (cpart) {
		Parts putting; int n; chars s = Tcl_GetStringFromObj(cpart,&n);
		if (!parts) {decr(cpart); return 0;}
		putting = putPart(parts,part,s,n,state);
		if (!putting) {
			beforeParts(parts,part,-1,s,n,state);
		}
		decr(cpart);
		R = generateURI(intr,parts);
	}else {
		R = 0;
	}
	while (parts) parts = deletePart(parts);
	return R;
}

		

Obj wyrm_uriPut(Intr intr,Obj uri,chars part,Obj newpart);

Obj wyrm_uriPutList(Intr intr,Obj uri,int N,Obj *P) {
	Parts parts = parseURI(intr,uri),putting; Obj R;
	if (!parts) return 0;
	while (N>1) {
		chars part = Tcl_GetStringFromObj(P[0],0); Obj cpart;
		Obj newpart = incr(P[1]); int n; chars s; char state = 'D';
		if (streq(part,"macintosh")) {
			Obj X = convertMacintosh(intr,newpart);
			if (X) {
				decr(newpart); newpart = X;
				part = "path"; state = 'E';
			}
		}else if (streq(part,"PATH") || strieq(part,"unix")) {
			Obj X = convertUnix(intr,newpart);
			if (X) {
				decr(newpart); newpart = X;
				part = "path"; state = 'E';
			}
		}
		cpart = streq(part,"path") ? canonicalPath(newpart) : newpart;
		s = Tcl_GetStringFromObj(cpart,&n);
		N -= 2; P += 2;
		putting = putPart(parts,part,s,n,state);
		if (!putting) {
			beforeParts(parts,part,-1,s,n,state);
		}
		decr(cpart);
	}
	R = generateURI(intr,parts);
	while (parts) parts = deletePart(parts);
	return R;
}

		

Obj wyrm_uriPutList(Intr intr,Obj uri,int N,Obj *P);

Obj wyrm_uriRemove(Intr intr,Obj uri,chars part) {
	Parts parts = parseURI(intr,uri),removing; Obj R;
	if (!parts) return 0;
	removing = findPart(parts,part);
	if (removing) removing = deletePart(removing);
	if (streq(part,"scheme")) {
		parts = beforeParts(removing,"scheme",-1,"(relative)",-1,'e')->prev;
		parts = parts->prev;
	}
	R = generateURI(intr,parts);
	while (parts) parts = deletePart(parts);
	return R;
}

		

Obj wyrm_uriRemove(Intr intr,Obj uri,chars part);

static pPart absp(pPart p) {return p && p->value ? p : 0;}

Obj wyrm_uriAbsolutise(Intr intr,Obj rel,Obj base) {
	Parts rparts = parseURI(intr,rel);
	if (streq(getPart(rparts,"scheme")->value,"(relative)")) {
		pPart	ruser  = absp(getPart(rparts,"user"));
		pPart	rhost  = absp(getPart(rparts,"host"));
		pPart	rport  = absp(getPart(rparts,"port"));
		Parts	bparts = parseURI(intr,base);
		if (bparts) {
			putPart(rparts,"scheme",bparts->value,bparts->length,-1);
			if (!ruser && !rhost && !rport) {
				pPart	buser  = absp(getPart(bparts,"user"));
				pPart	bhost  = absp(getPart(bparts,"host"));
				pPart	bport  = absp(getPart(bparts,"port"));
				pPart	rpath  = absp(getPart(rparts,"path"));
				if (buser) putPart(rparts,"user",buser->value,buser->length,-1);
				if (bhost) putPart(rparts,"host",bhost->value,bhost->length,-1);
				if (bport) putPart(rparts,"port",bport->value,bport->length,-1);
				if (!(rpath && rpath->length>0 && rpath->value[0]=='/')) {
					pPart	bpath  = absp(getPart(bparts,"path"));
					chars s; int n;
					Obj S = incr(Tcl_NewObj());
					if (bpath) {
						s = bpath->value; n = bpath->length;
						while (n>0 && s[n-1]!='/') n--;
						Tcl_AppendToObj(S,s,n);
					}
					if (bpath && rpath) {
						Tcl_AppendToObj(S,"/",-1);
					}
					if (rpath) {
						Tcl_AppendToObj(S,rpath->value,rpath->length);
					}
					S = canonicalPath(S);
					s = Tcl_GetStringFromObj(S,&n);
					putPart(rparts,"path",s,n,-1);
					decr(S);
				}
			}
			while (bparts) bparts = deletePart(bparts);
		}else {
			rel = 0; goto exit;
		}
	}
	rel = generateURI(intr,rparts);
exit:
	while (rparts) rparts = deletePart(rparts);
	return rel;
}

		

Obj wyrm_uriAbsolutise(Intr intr,Obj rel,Obj base);

int wyrm_uriMethod(Intr intr,Obj uri,chars method,int N,Obj *P) {
	Obj substkey = oprintf("subst.%{y}s",uri);
	Obj subst = wyrm_oavGet(intr,wyrm_urispace(intr,0),substkey,0,0);
	Obj actualuri = subst ? subst : incr(uri);
	Parts parts = parseURI(intr,actualuri);
	decr(substkey);
	if (parts) {
		chars scheme = parts->value;
		Obj	key = oprintf("uri.%s.%s",scheme,method);
		int rc; Obj *Q;
		Q = nheap(N+1,Obj);
		*Q = actualuri;
		if (N>0) memcpy(Q+1,P,sizeof(Obj)*N);
		rc = wyrm_oavDo(intr,wyrm_urispace(intr,0),key,N+1,Q);
		if (rc!=TCL_OK) {
			chars r = Tcl_GetStringResult(intr);
			chars k = Tcl_GetStringFromObj(key,0);
			static char  missing[] = "missing: ";
			if (strbegins(missing,r) && streq(k,r+sizeof missing-1)) {
				rprintf(intr,"unknown %s method: %s",scheme,method);
			}
		}
		while (parts) parts = deletePart(parts);
		decr(key); dispose(Q); decr(actualuri);
		return rc;
	}else {
		decr(actualuri); return TCL_ERROR;
	}
}

		

int wyrm_uriMethod(Intr intr,Obj uri,chars method,int N,Obj *P);

Obj wyrm_urispace(Intr intr,Obj newspace) {
	Obj urispace = newspace
		? Tcl_SetVar2Ex(intr,"::wyrm::wif::urispace",0,newspace,0)
		: Tcl_GetVar2Ex(intr,"::wyrm::wif::urispace",0,0);
	return urispace;
}

		

Obj wyrm_urispace(Intr intr,Obj newspace);

static void escapeString(Tcl_DString *S,chars s,int n,chars does,chars dont) {
	while (n>0) {
		char c[8]; int m;
		bool e = *s==0 ? true
				: does && strchr(does,*s)!=0 ? true
				: dont && strchr(dont,*s)!=0 ? false
				: *s<=32 || 127<=*s ? true
				: !(isalnum(*s) || *s=='-' || *s=='_' || *s=='.' || *s=='!'
								|| *s=='~' || *s=='*' || *s=='+' || *s=='\''
								|| *s=='(' || *s==')' || *s=='=' || *s=='/');
		if (e) {
			sprintf(c,"%%%02X",*s); m = -1;
		}else {
			c[0] = *s; c[1] = 0; m = 1;
		}
		Tcl_DStringAppend(S,c,m); s++; n--;
	}
}

		

static void escapeString(Tcl_DString *S,chars s,int n,chars does,chars dont);

		

static int deescapeString(chars s,int n,chars r) {
	int m = 0; char x[3]; x[2] = 0;
	while (n>0) {
		if (n>=3 && s[0]=='%' && isxdigit(s[1]) && isxdigit(s[2])) {
			x[0] = s[1]; x[1] = s[2]; s+=3; n-=3;
			*r++ = strtol(x,0,16); m++;
		}else {
			*r++ = *s++; m++; n--;
		}
	}
	*r = 0;
	return m;
}

		

static int deescapeString(chars s,int n,chars r);

		

static Parts parseURI(Intr intr,Obj uri) {
	chars		scheme;
	Tcl_RegExp	re;
	Parts		parts = 0;
	Obj			pattern = 0, partlist = 0;
	<Parse uri scheme>
	<Parse the uri with the scheme pattern>
	<Assigned parsed substrings to parts>
exit:
	decr(pattern);
	decr(partlist);
	return parts;
error:
	while (parts) parts = deletePart(parts);
	goto exit;
}

		

static Parts parseURI(Intr intr,Obj uri);

		

{

Obj key = oprintf("uri.%s.+pattern",scheme);
Obj urispace = wyrm_urispace(intr,0);
pattern = wyrm_oavGet(intr,urispace,key,0,0);
decr(key); key = 0;

		}

{

Obj key = oprintf("uri.%s.+parts",scheme);
partlist = wyrm_oavGet(intr,wyrm_urispace(intr,0),key,0,0);
decr(key); key = 0;

		}

Obj key = oprintf("uri.%s.+generate",scheme);
Obj g = wyrm_oavGet(intr,wyrm_urispace(intr,0),key,0,0);
chars generate = g ? Tcl_GetStringFromObj(g,0) : 0;

		

{

int n,i; chars s = Tcl_GetStringFromObj(uri,&n);
for (i=0; ; i++) {
	if (s[i]==':') {
		n = i;
		break;
	}else if (i>=n || !(isalnum(s[i]) || s[i]=='%' || s[i]=='-' || s[i]=='+' || s[i]=='.')) {
		s = "(relative)"; n = strlen(s);
		break;
	}
}
parts = beforeParts(0,"scheme",-1,s,n,'e');
deescapePart(parts); scheme = parts->value;
		
		}

{

chars u = Tcl_GetStringFromObj(uri,0);
int rc;
<Get the scheme specific parse pattern>
if (!pattern) {
	rprintf(intr,"(missing generic pattern: scheme %s)",scheme);
	goto error;
}
re = Tcl_RegExpCompile(intr,Tcl_GetStringFromObj(pattern,0));
if (!re) goto error;
rc = Tcl_RegExpExec(intr,re,u,u);
if (rc<0) {
	goto error;
}else if (rc==0) {
	rprintf(intr,"could not parse uri: scheme %s: pattern %{y}s",scheme,pattern);
	goto error;
}

		}

{

int i,N; Obj *P;
<Get the scheme specific parts list>
if (!partlist) {
	rprintf(intr,"<parts are missing: scheme %s>",scheme);
	goto error;
}
if (Tcl_ListObjGetElements(intr,partlist,&N,&P)!=TCL_OK) goto error;
for (i=0; i<N; i++) {
	int n; chars name = Tcl_GetStringFromObj(P[i],&n);
	chars first,last;
	if (streq(name,"scheme")) continue;
	Tcl_RegExpRange(re,i+1,(CONST char**)&first,(CONST char**)&last);
	beforeParts(parts,name,n,first,first ? last-first : 0,first ? 'e' : '.');
}

		}

			
<Generate URI from parts recursive step>

static Obj generateURI(Intr intr,Parts parts) {
	if (!parts) {
		return 0;
	}else {
		chars scheme = parts->value; Obj partlist;
		pPart *vp = 0;
		<Get scheme specific parts>
		for (i=0,curr=parts; i<N; i++,j++) {
			chars name = Tcl_GetStringFromObj(P[i],0);
			if (streq(name,"parameter")) xparam = j;
			p = curr;
			do {
				if (streq(p->name,name)) {
					vp[j] = p; curr = p->next; break;
				}
			} while (p=p->next,p!=curr);
		}
		<Repack separated parameters>
		decr(partlist);
		<Generate URI from scheme parts list and format>
	}
}

		

static Obj generateURI(Intr intr,Parts parts);

		

case 'x':
	(*part) += 1;
	break;

		

case 'h':
	if ((**part) && any0 && (**part)->value && (**part)->length) {
		escapePart((**part),0,0);
		if ((**part)->length==0 || (**part)->value[0]!='/')
			Tcl_AppendToObj(G0,"/./",-1);
	}
	break;

		

		case 's':
			if ((**part) && (**part)->value) {
				escapePart((**part),0,0);
				Tcl_AppendToObj(G0,(**part)->value,(**part)->length);
				any0 = true;
			}
			(*part) += 1;
			break;

		

case 'r':
	if ((**part) && (**part)->value) {
		escapePart((**part),0,"&?");
		Tcl_AppendToObj(G0,(**part)->value,(**part)->length);
		any0 = true;
	}
	(*part) += 1;
	break;

		

		case 'p':
			if ((**part) && (**part)->value) {
				escapePart((**part),0,";=");
				Tcl_AppendToObj(G0,(**part)->value,(**part)->length);
				any0 = true;
			}
			(*part) += 1;
			break;

		

		case 'a':
			if ((**part) && (**part)->value) {
				escapePart((**part),0,"@");
				Tcl_AppendToObj(G0,(**part)->value,(**part)->length);
				any0 = true;
			}
			(*part) += 1;
			break;

		

case '(':/*)*/
	generateRcr(G0,generate,part,&any0);
	break;
case /*(*/')':
	if (any0) {
		Tcl_AppendObjToObj(G,G0);
		if (any) *any = true;
	}
	decr(G0);
	return;

		

default:
	Tcl_AppendToObj(G0,c,1);
	break;

		

int i,j,xparam=-1,N; Obj *P; pPart p,curr;
<Get the scheme specific parts list>
if (!partlist) {
	rprintf(intr,"<parts are missing: scheme %s>",scheme);
	return 0;
}
if (Tcl_ListObjGetElements(intr,partlist,&N,&P)!=TCL_OK) {
	decr(partlist); return 0;
}
vp = nheap(N+1,pPart); memset(vp,0,sizeof(pPart)*(N+1));
if (streq(Tcl_GetStringFromObj(P[0],0),"scheme")) {
	j = 0;
}else {
	vp[0] = parts; j = 1;
}

		

{

<Get the scheme specific generate format>
Obj uri = incr(Tcl_NewObj()); pPart *vp1 = vp;
decr(key);
if (!generate) {
	rprintf(intr,"<missing generic generate: scheme %s>",parts->value);
	decr(g); decr(uri); dispose(vp);
	return 0;
}
generateRcr(uri,&generate,&vp1,0);
decr(g); dispose(vp);
return uri;

		}

static void generateRcr(Obj G,chars *generate,pPart **part,bool *any) {
	bool any0 = false; Obj G0 = incr(Tcl_NewObj());
	while (**generate) {
		chars c = *generate; *generate += 1;
		switch (*c) {
			<Generate x part>
			<Generate h part>
			<Generate s part>
			<Generate r part>
			<Generate p part>
			<Generate a part>
			<Generate optional part>
			<Generate literal character>
		}
	}
	Tcl_AppendObjToObj(G,G0); if (any) *any = any0; decr(G0);
}

		

static Obj canonicalPath(Obj path) {
	if (path) {
		int n; chars p = Tcl_GetStringFromObj(path,&n);
		if (n>0) {
			Obj cpath = incr(Tcl_NewObj());
			typedef struct L L;
			struct L {chars p; int n; L *l;};
			L *l=0,*q,*c,*r; int pre = 0; bool dir = false; chars sep;
			#define push		(c=heap(L), c->p=p, c->n=0, c->l=l, l=c)
			#define curr		(c=heap(L), c->p=".", c->n=1, c->l=l, l=c)
			#define pop			(c=l->l, dispose(l), l=c)
			#define is(x)		(n>=((int)sizeof(x))-1 && memcmp(p,x,((int)sizeof(x))-1)==0)
			#define done		(n==0)
			#define when(p)		if (p) {
			#define whenever	{
			#define next(s)		; goto s;}
			#define skip		(n--, p++)
			#define shift		(l->n++, n--, p++)
			//}
	
			/*wyrminitial:*/
				when(is("/./")) 	skip;			next(initial)
				whenever							next(initial)
			initial:
				when(is("."))		push; shift;	next(dot)
				when(is("/"))		pre=-1; skip;	next(segment)
				when(done)							next(endpath)
				whenever			push; shift;	next(insegment)
			segment:
				when(is("."))		push; shift;	next(dot)
				when(is("/"))		skip;			next(segment)
				when(done)							next(enddir)
				whenever			push; shift;	next(insegment)
			dot:
				when(is("."))		shift;			next(dotdot)
				when(is("/"))		pop; skip;		next(segment)
				when(done)			pop;			next(endpath)
				whenever			shift;			next(insegment)
			dotdot:
				when(is("/"))		pop;			next(popagain)
				when(done)			pop;			next(popagain)
				whenever			shift;			next(insegment)
			popagain:
				when(!l&&pre>=0)	pre++;			next(popped)
				when(!l&&pre<0)						next(popped)
				whenever			pop;			next(popped)
			popped:
				when(is("/"))		skip;			next(segment)
				when(done)							next(endpath)
				whenever							next(segment)
			insegment:
				when(is("/"))						next(segment)
				when(done)							next(endpath)
				whenever			shift;			next(insegment)
			endpath:
				when(!l)			curr;			next(finish)
				when(done)							next(finish)
			enddir:
				when(!l)			curr; dir=true;	next(finish)
				when(done)			dir=true;		next(finish)
			#undef push
			#undef curr
			#undef pop
			#undef is
			#undef done
			#undef when
			#undef whenever
			#undef next
			#undef skip
			#undef shift
			finish:
				for (q=0,c=l; c; q=c,c=r) {r=c->l; c->l=q;} l = q;
				if (pre<0)
					sep = "/";
				else {
					for (sep=""; pre>0; sep="/",pre--) {
						Tcl_AppendToObj(cpath,sep,-1);
						Tcl_AppendToObj(cpath,"..",-1);
					}
				}
				while (l) {
					Tcl_AppendToObj(cpath,sep,-1); sep = "/";
					Tcl_AppendToObj(cpath,l->p,l->n);
					r = l->l; dispose(l); l = r;
				}
				if (dir) Tcl_AppendToObj(cpath,"/",-1);
				decr(path); return cpath;
		}else
			return path;
	}else {
		return 0;
	}
}

		

static Obj canonicalPath(Obj path);

		

{

gotten = getEscapedPart(parts,"path");
if (!gotten) {
	rprintf(intr,"unknown part: path"); R = 0;
}else if (!gotten->value) {
	rprintf(intr,"missing: path"); R = 0;
}else {
	chars s; int n; Obj L = incr(Tcl_NewObj());
	bool trailingSlash;
	R = canonicalPath(incr(Tcl_NewStringObj(gotten->value,gotten->length)));
	s = Tcl_GetStringFromObj(R,&n);
	if (n>=1 && *s=='/') {
		Tcl_ListObjAppendElement(0,L,Tcl_NewStringObj("/",-1));
		s++,n--;
	}else if (n==1 && *s=='.') {
		;
	}else if (n>=2 && memcmp(s,"./",2)==0) {
		;
	}else if (n>=3 && memcmp(s,"../",3)==0) {
		;
	}else {
		Tcl_ListObjAppendElement(0,L,Tcl_NewStringObj(".",-1));
	}
	trailingSlash = n>=1 && s[n-1]=='/'; n -= trailingSlash;
	while (n>0) {
		chars p = memchr(s,'/',n); int m = p ? p-s : n;
		chars q = nheap(m+1,char);
		int   r = deescapeString(s,m,q);
		Tcl_ListObjAppendElement(0,L,Tcl_NewStringObj(q,r));
		dispose(q); s += m+1; n -= m+1;
	}
	if (trailingSlash) Tcl_ListObjAppendElement(0,L,Tcl_NewStringObj("/",-1));
	decr(R); R = L; L = 0;
	<Get Macintosh file join compatiable path list>
}

		}

static Obj convertUnix(Intr intr,Obj part) {
	int N; Obj *P;
	if (Tcl_ListObjGetElements(intr,part,&N,&P)==TCL_OK) {
		int n; chars s,sep=""; Tcl_DString S; Obj X;
		bool finalslash;
		Tcl_DStringInit(&S);
		s = N>=1 ? Tcl_GetStringFromObj(*P,&n) : 0;
		if (!s) {
			;
		}else if (n==1 && memcmp(s,"/",n)==0) {
			P++,N--; Tcl_DStringAppend(&S,"/",-1); sep="";
		}else if (n==1 && memcmp(s,".",n)==0) {
			P++,N--; Tcl_DStringAppend(&S,".",-1); sep="/";
		}else while (N>=1 && n==2 && memcmp(s,"..",2)==0) {
			Tcl_DStringAppend(&S,sep,-1); sep="/";
			Tcl_DStringAppend(&S,"..",-1);
			P++,N--; s = N>=1 ? Tcl_GetStringFromObj(*P,&n) : 0;
		}
		s = N>=1 ? Tcl_GetStringFromObj(P[N-1],&n) : 0;
		finalslash = s && n==1 && memcmp(s,"/",n)==0;
		if (finalslash) N--;
		while (N>0) {
			s = Tcl_GetStringFromObj(*P,&n);
			Tcl_DStringAppend(&S,sep,-1); sep="/";
			escapeString(&S,s,n,"/",0);
			P++,N--;
		}
		if (finalslash) Tcl_DStringAppend(&S,"/",-1);
		X = incr(Tcl_NewStringObj(
				Tcl_DStringValue(&S),
				Tcl_DStringLength(&S)));
		Tcl_DStringFree(&S);
		return X;
	}else
		return 0;
}

		

if (strieq(part,"macintosh")) {
	int N=0; Obj *P;
	L = incr(Tcl_NewObj());
	Tcl_ListObjGetElements(0,R,&N,&P);
	N -= trailingSlash;
	s = N>=1 ? Tcl_GetStringFromObj(*P,&n) : 0;
	if (!s)
		;
	else if (n==1 && memcmp(s,"/",n)==0) {
		if (N==1) {
			Tcl_ListObjAppendElement(0,L,Tcl_NewStringObj("/:",-1));
			P++,N--;
		}else {
			Obj X = incr(Tcl_DuplicateObj(P[1]));
			Tcl_AppendToObj(X,":",-1);
			Tcl_ListObjAppendElement(0,L,X);
			decr(X); P+=2,N-=2;
		}
	}else if (n==1 && memcmp(s,".",n)==0) {
		P++,N--;
	}else while (N>=1 && n==2 && memcmp(s,"..",n)==0) {
		Tcl_ListObjAppendElement(0,L,Tcl_NewStringObj("::",-1));
		P++,N--;
		s = N>=1 ? Tcl_GetStringFromObj(*P,&n) : 0;
	}
	while (N>0) {
		Tcl_ListObjAppendElement(0,L,*P);
		P++,N--;
	}
	decr(R); R = L; L = 0;
}

		

static Obj convertMacintosh(Intr intr,Obj part) {
	int N; Obj *P;
	if (Tcl_ListObjGetElements(intr,part,&N,&P)==TCL_OK) {
		int n; chars s,sep=""; Tcl_DString S; Obj X;
		Tcl_DStringInit(&S);
		s = N>=1 ? Tcl_GetStringFromObj(*P,&n) : 0;
		if (!s) {
			Tcl_DStringAppend(&S,".",-1); sep="/";
		}else if (n>=2 && s[n-1]==':' && (n!=2 || memcmp(s,"::",n)!=0)) {
			P++,N--; Tcl_DStringAppend(&S,"/",-1); sep="/";
			escapeString(&S,s,n-1,"/",0);
		}else while (N>=1 && n==2 && memcmp(s,"::",2)==0) {
			Tcl_DStringAppend(&S,sep,-1); sep="/";
			Tcl_DStringAppend(&S,"..",-1);
			P++,N--; s = N>=1 ? Tcl_GetStringFromObj(*P,&n) : 0;
		}
		while (N>0) {
			s = Tcl_GetStringFromObj(*P,&n);
			Tcl_DStringAppend(&S,sep,-1); sep="/";
			escapeString(&S,s,n,"/",0);
			P++,N--;
		}
		X = incr(Tcl_NewStringObj(
				Tcl_DStringValue(&S),
				Tcl_DStringLength(&S)));
		Tcl_DStringFree(&S);
		return X;
	}else
		return 0;
}

		

if (parameter && *name==';') {
	if (parameter->value) {
		chars value = parameter->value; pPart q = parameter->prev;
		int   length = parameter->length;
		while (length>0) {
			chars semi  = memchr(value+1,';',length);
			chars equal = memchr(value,'=',length);
			chars pval; int   m,n,p;
			if (!semi)  semi = value+length;
			if (equal && equal>semi) equal = 0;
			m = semi-value; n = equal ? equal-value : m;
			pval = equal ? equal+1 : 0; p = pval ? semi-pval : 0;
			beforeParts(parameter,value,n,pval,p,parameter->state);
			value = semi; length -= m;
		}
		while (q=q->next, q!=parameter) {
			if (q->value==0) {
				q->value = nheap(2,char); strcpy(q->value,"1");
				q->length = 1; q->state = '1';
			}else if (islower(q->state)) {
				chars copy = nheap(q->length+1,char);
				memcpy(copy,q->value,q->length); copy[q->length] = 0;
				q->value = copy;
				q->state = toupper(q->state);
			}
		}
	}
	deletePart(parameter);
	return findPart(parts,name);
}

		

if (xparam>=0) {
	p = parts;
	do {
		if (p->name[0]==';') {
			pPart prm;
			chars oval,nval,nname=p->name;
			int   olen,nlen,nklen=strlen(nname);
			if (!vp[xparam]) {
				vp[xparam] = beforeParts(parts,"parameter",-1,0,0,'.')->prev;
			}
			prm = vp[xparam]; oval = prm->value; olen = prm->length;
			escapePart(p,";=",0);
			nval = p->value; nlen = p->length;
			if (p->state=='1' || nval==0 || nlen==0) {
				oval = reheap(olen+nklen+1,char,oval);
				memcpy(oval+olen,nname,nklen);
				oval[olen+nklen] = 0;
				prm->length += nklen;
				prm->value = oval;
				prm->state = 'D';
			}else {
				oval = reheap(olen+nklen+1+nlen+1,char,oval);
				memcpy(oval+olen,nname,nklen);
				oval[olen+nklen] = '=';
				memcpy(oval+olen+nklen+1,nval,nlen);
				oval[olen+nklen+1+nlen] = 0;
				prm->length += nklen+1+nlen;
				prm->value = oval;
				prm->state = p->state;
			}
		}
	} while (p=p->next,p!=parts);
}

		

struct Part{
	pPart	prev,next;
	chars	value; int length;
	char	state;
	char	name[1];
};

<Insert part before position>
<Delete part>
<Convert deescaped part to escaped part>
<Convert escaped part to deescaped part>
<Find a part>
<URI parse patterns>
<Get a string from the parts>
<Get an escaped string from the parts>
<Put a raw string into the parts>
<Generate URI from parts>
			
		

static Parts beforeParts(Parts base,chars name,int nname,chars value,int length,int state) {
	pPart p;
	if (nname<0) nname = strlen(name);
	p = allocate(sizeof(Part)+nname);
	if (length<0) length = strlen(value);
	p->length = length; p->state = state;
	if (isupper(state)) {
		p->value = nheap(length+1,char);
		memcpy(p->value,value,length); p->value[length] = 0;
	}else {
		p->value = value;
	}
	memcpy(p->name,name,nname); p->name[nname] = 0;
	if (base) {
		base->prev->next = p;
		p->prev = base->prev; p->next = base;
		base->prev = p;
	}else {
		base = p->prev = p->next = p;
	}
	return base;
}

		

static Parts deletePart(Parts p) {
	pPart prev=p->prev,next=p->next;
	if (!islower(p->state)) {
		dispose(p->value);
	}
	if (p==next) {
		next = 0;
	}else {
		prev->next = next;
		next->prev = prev;
	}
	dispose(p);
	return next;
}

		

static pPart findPart(Parts parts,chars name) {
	if (parts) {
		pPart parameter=0,curr=parts;
		do {
			if (streq(curr->name,name)) return curr;
			if (streq(curr->name,"parameter")) parameter = curr;
		} while (curr=curr->next, curr!=parts);
		<Split parameter part into separate parts>
	}
	return 0;
}

		

static void escapePart(pPart part,chars does,chars dont) {
	if (tolower(part->state)=='d') {
		chars s = part->value; int n = part->length;
		Tcl_DString S;
		Tcl_DStringInit(&S);
		escapeString(&S,s,n,does,dont);
		if (part->state=='D') dispose(part->value);
		part->state = 'E'; part->length = Tcl_DStringLength(&S);
		part->value = nheap(part->length+1,char);
		strcpy(part->value,Tcl_DStringValue(&S));
		Tcl_DStringFree(&S);
	}
}

		

static void deescapePart(pPart part) {
	if (tolower(part->state)=='e') {
		chars value = nheap(part->length+1,char);
		int m = deescapeString(part->value,part->length,value);
		if (part->state=='E') dispose(part->value);
		part->state = 'D'; part->length = m;
		part->value = reheap(m+1,char,value);
	}
}

		

static pPart getPart(Parts part,chars name) {
	part = findPart(part,name);
	if (part && part->length>=0) {
		deescapePart(part);
	}
	return part;
}

		

static pPart getEscapedPart(Parts part,chars name) {
	part = findPart(part,name);
	if (part && part->length>=0) {
		escapePart(part,0,0);
	}
	return part;
}

		

static pPart putPart(Parts part,chars name,chars value,int length,int state) {
	part = findPart(part,name);
	if (part) {
		if (part->value && isupper(part->state)) {dispose(part->value);}
		part->value = nheap(length+1,char); part->length = length;
		memcpy(part->value,value,length); part->value[length] = 0;
		part->state = state<0 ? 'D' : state;
	}
	return part;
}

		

		
<Protocol task>
<Close close task>



static int uriassist(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]) {
	ProtocolTask *(*activeProtocol) = Tcl_GetThreadData(&activeProtocolKey,sizeof(ProtocolTask*));
	int N0 = N; Obj *P0 = P; int rc,index;
	static chars subcommand[] = {
			"scanname","protocol","channel","puts","log","closeclose",
			0
	};
	enum {
			o_scanname,o_protocol,o_channel,o_puts,o_log,o_closeclose
	};
	if (N<=1) {
		Tcl_WrongNumArgs(intr,1,P0,"subcommand ..."); return TCL_ERROR;
	}
	if (Tcl_GetIndexFromObj(intr,P[1],(CONST char**)subcommand,"subcommand",0,&index)!=TCL_OK) {
		return TCL_ERROR;
	}
	N -= 2; P += 2;
	switch (index) {
		case o_scanname:
			if (N==2) {
				Obj name; chars dot = "";
				int n; bytes block = Tcl_GetByteArrayFromObj(P[0],&n);
				int offset,returnoffset; bool jumped = false,*hit;
				if (Tcl_GetIntFromObj(intr,P[1],&offset)!=TCL_OK) return TCL_ERROR;
				name = incr(Tcl_NewObj()); hit = nheap(n,bool); zero(n,bool,hit);
				returnoffset = offset;
				for (rc=TCL_OK; rc==TCL_OK && offset>0;) {
					if ((block[offset]&0xC0)==0xC0) {
						if (!jumped) returnoffset = offset+2;
						offset = ((block[offset]<<8)+block[offset+1])&0x3FFF;
						if (offset>=n) rc = rprintf(intr,"%!name offset outside of block",TCL_ERROR);
						jumped = true;
					}else if (hit[offset]) {
						rc = rprintf(intr,"%!name offset loops in block",TCL_ERROR);
					}else if (block[offset]+offset>n) {
						rc = rprintf(intr,"%!name string beyond end of block",TCL_ERROR);
					}else if (block[offset]==0) {
						offset += 1;
						if (!jumped) returnoffset = offset;
						break;
					}else {
						Tcl_AppendToObj(name,dot,-1); dot = ".";
						Tcl_AppendToObj(name,(chars)(&block[offset+1]),block[offset]);
						offset += block[offset]+1;
						if (!jumped) returnoffset = offset;
					}
				}
				if (rc==TCL_OK) {
					Obj E[2]; E[0] = name; E[1] = Tcl_NewIntObj(returnoffset);
					Tcl_SetObjResult(intr,Tcl_NewListObj(2,E));
				}
				decr(name); dispose(hit);
				return rc;
			}else {
				Tcl_WrongNumArgs(intr,2,P0,"block offset"); return TCL_ERROR;
			}
		case o_protocol:
			if (N>=2 && N%2==0) {
				int mood; Tcl_Channel channel = Tcl_GetChannel(intr,Tcl_GetString(P[0]),&mood);
				int nv = N-2; Obj *pv = P+1;
				ProtocolTask T = {intr,channel,0,0,0,0,0,TCL_OK,0};
				if (!channel) return TCL_ERROR;
				if (!(mood&TCL_READABLE)) return rprintf(intr,"%!channel not readable",TCL_ERROR);
				if (!(mood&TCL_WRITABLE)) return rprintf(intr,"%!channel not writable",TCL_ERROR);
				if (Tcl_ListObjGetElements(intr,P[N-1],&T.ns,&T.ps)!=TCL_OK) return TCL_ERROR;
				if (T.ns%3!=0) return rprintf(intr,"%!switch length is not a multiple of three",TCL_ERROR);
				if (asynchronous(&T)) {
					ProtocolTask *t;
					if (Tcl_SetChannelOption(intr,channel,"-blocking","0")!=TCL_OK) return TCL_ERROR;
					t = heap(ProtocolTask); *t = T;
					t->scripts = incr(P[N-1]);
					t->label = nheap(4,char); strcpy(t->label,"GET");
					Tcl_Preserve(intr);
					Tcl_CreateChannelHandler(channel,TCL_READABLE|TCL_EXCEPTION,protocolTask,t);
					Tcl_ResetResult(intr);
					return TCL_OK;
				}else {
					if (Tcl_SetChannelOption(intr,channel,"-blocking","1")!=TCL_OK) return TCL_ERROR;
					for (; nv>0; nv-=2,pv+=2) {
						if (!Tcl_ObjSetVar2(intr,pv[0],0,pv[1],TCL_LEAVE_ERR_MSG)) return TCL_ERROR;
					}
					T.label = nheap(4,char); strcpy(T.label,"GET");
					protocolTask((ClientData)(&T),TCL_READABLE);
					if (T.rc==TCL_OK) {
						Obj output = variable(&T,"output");
						if (output) Tcl_SetObjResult(intr,output);
						else Tcl_ResetResult(intr);
					}
					return T.rc;
				}
			}else {
				Tcl_WrongNumArgs(intr,2,P0,"channel [var val]... switch"); return TCL_ERROR;
			}
		case o_channel:
			if (N==1 || N==2) {
				if (!(*activeProtocol)) {
					return rprintf(intr,"not in an active protocol block",TCL_ERROR);
				}else {
					chars newlabel = N==2 ? Tcl_GetString(P[1]) : 0;
					int mood; Tcl_Channel channel = Tcl_GetChannel(intr,Tcl_GetString(P[0]),&mood);
					if (!channel) return TCL_ERROR;
					if (!(mood&TCL_READABLE)) return rprintf(intr,"%!channel not readable",TCL_ERROR);
					if (asynchronous(0)) {
						if (Tcl_SetChannelOption(intr,channel,"-blocking","0")!=TCL_OK) return TCL_ERROR;
						Tcl_DeleteChannelHandler((*activeProtocol)->channel,protocolTask,(*activeProtocol));
						Tcl_CreateChannelHandler(channel,TCL_READABLE|TCL_EXCEPTION,protocolTask,(*activeProtocol));
					}else {
						if (Tcl_SetChannelOption(intr,channel,"-blocking","1")!=TCL_OK) return TCL_ERROR;
					}
					if (newlabel) {
						dispose((*activeProtocol)->label);
						(*activeProtocol)->label = nheap(1+strlen(newlabel),char);
						strcpy((*activeProtocol)->label,newlabel);
					}
					(*activeProtocol)->channel = channel;
					Tcl_ResetResult(intr);
					return TCL_OK;
				}
			}else {
				Tcl_WrongNumArgs(intr,2,P0,"channel [label]"); return TCL_ERROR;
			}
		case o_puts:
			if (N==2) {
				int mood; Tcl_Channel channel = Tcl_GetChannel(intr,Tcl_GetString(P[0]),&mood);
				Obj line = P[1];
				if (!channel) return TCL_ERROR;
				if (!(mood&TCL_WRITABLE)) return rprintf(intr,"%!channel not writable",TCL_ERROR);
				cprintf(channel,"%{y}s\n",line);
				if (logging(0)) cprintf(chstderr,"PUT %{y}s\n",line);
				Tcl_ResetResult(intr);
				return TCL_OK;
			}else {
				Tcl_WrongNumArgs(intr,2,P0,"channel line"); return TCL_ERROR;
			}
		case o_log:
			if (N==1) {
				if (logging(0)) cprintf(chstderr,"%{y}s\n",P[0]);
				Tcl_ResetResult(intr);
				return TCL_OK;
			}else {
				Tcl_WrongNumArgs(intr,2,P0,"line"); return TCL_ERROR;
			}
		case o_closeclose:
			if (N==2) {
				Tcl_Channel channel1 = Tcl_GetChannel(intr,Tcl_GetString(P[0]),0);
				Tcl_Channel channel2 = Tcl_GetChannel(intr,Tcl_GetString(P[1]),0);
				ClosecloseTask *t;
				if (!channel1 || !channel2) return TCL_ERROR;
				t = heap(ClosecloseTask);
				t->intr = intr; t->channel = channel2;
				Tcl_Preserve(intr);
				Tcl_CreateCloseHandler(channel1,closecloseTask,t);
				Tcl_ResetResult(intr);
				return TCL_OK;
			}else {
				Tcl_WrongNumArgs(intr,2,P0,"channel1 channel2"); return TCL_ERROR;
			}
	}
	return rc;
}

		

		
static bool channelIsBlocking(Intr intr,Tcl_Channel channel) {
	return blocking;
}

		

		
typedef struct {
	Intr intr; Tcl_Channel channel;
	Obj scripts; int ns; Obj *ps;
	Obj line;
	Obj vars;
	int rc; chars label;
} ProtocolTask;

static Tcl_ThreadDataKey activeProtocolKey;

static chars logging(ProtocolTask *t) {
	ProtocolTask *(*activeProtocol) = Tcl_GetThreadData(&activeProtocolKey,sizeof(ProtocolTask*));
	Obj obj; int l;
	if (!t) t = (*activeProtocol);
	if (!t) return 0;
	obj = Tcl_GetVar2Ex(t->intr,"logging",0,0);
	return obj && Tcl_GetBooleanFromObj(0,obj,&l)==TCL_OK && l ? t->label : 0;
}

static bool asynchronous(ProtocolTask *t) {
	ProtocolTask *(*activeProtocol) = Tcl_GetThreadData(&activeProtocolKey,sizeof(ProtocolTask*));
	Obj obj; int n;
	if (!t) t = (*activeProtocol);
	if (!t) return 0;
	obj = Tcl_GetVar2Ex(t->intr,"async",0,0);
	if (!obj) return 0;
	Tcl_GetStringFromObj(obj,&n);
	return n>0;
}

static Obj variable(ProtocolTask *t,chars var) {
	ProtocolTask *(*activeProtocol) = Tcl_GetThreadData(&activeProtocolKey,sizeof(ProtocolTask*));
	Obj obj;
	if (!t) t = (*activeProtocol);
	if (!t) return 0;
	obj = Tcl_GetVar2Ex(t->intr,var,0,TCL_LEAVE_ERR_MSG);
	return obj;
}

static void protocolTask(ClientData clientData,int mask) {
	ProtocolTask *(*activeProtocol) = Tcl_GetThreadData(&activeProtocolKey,sizeof(ProtocolTask*));
	ProtocolTask *t = (ProtocolTask*)clientData;
	Tcl_SavedResult safe;
	chars state,line; int i; chars label;
	bool async = asynchronous(t);
	if (async && Tcl_InterpDeleted(t->intr)) goto quit;
	while (t->rc==TCL_OK) {
		int nv; Obj *pv;
		if (mask&TCL_READABLE) {
			if (!t->line) t->line = incr(Tcl_NewObj());
			switch (cgets(t->channel,t->line)) {
			eof: case EOF: {
				Obj state = variable(t,"state");
				state = state ? oprintf("!%{y}s",state) : incr(Tcl_NewStringObj("!",1));
				Tcl_SetVar2Ex(t->intr,"state",0,state,0); decr(state);
				Tcl_SetStringObj(t->line,"EOF",3);
			}	break;
			err: case ERR: {
				Obj state = variable(t,"state");
				state = state ? oprintf("!%{y}s",state) : incr(Tcl_NewStringObj("!",1));
				Tcl_SetVar2Ex(t->intr,"state",0,state,0); decr(state);
				decr(t->line); t->line = oprintf("ERR %s",Tcl_PosixError(t->intr));
			}	break;
			case BLK:
				return;
			}
		}else if (Tcl_Eof(t->channel)) {
			goto eof;
		}else {
			goto err;
		}
		if (async) Tcl_SaveResult(t->intr,&safe);
		t->rc = Tcl_ListObjGetElements(t->intr,variable(t,"state"),&nv,&pv);
		state = t->rc==TCL_OK && nv>0 ? Tcl_GetString(*pv) : "";
		line = Tcl_GetString(t->line);
		if ((label=logging(t))) cprintf(chstderr,"%s <%s>%s\n",label,state,line);
		for (i=0; i<t->ns && t->rc==TCL_OK; i+= 3) {
			if (Tcl_StringMatch(state,Tcl_GetString(t->ps[i+0])) && Tcl_StringMatch(line,Tcl_GetString(t->ps[i+1]))) {
				ProtocolTask *oactiveProtocol = (*activeProtocol); Obj state;
				(*activeProtocol) = t;
				if (async) {
					Obj E[4],script; int rc; int nr; Obj *pr;
					E[0] = Tcl_NewStringObj("::wyrm::wif::protocol",-1);
					E[1] = t->line;
					E[2] = t->vars;
					E[3] = t->ps[i+2];
					script = incr(Tcl_NewListObj(4,E));
					decr(t->vars); t->vars = 0; decr(t->line); t->line = 0;
					Tcl_EvalObjEx(t->intr,t->ps[i+2],0);
					decr(script);
					t->rc = Tcl_ListObjGetElements(t->intr,Tcl_GetObjResult(t->intr),&nr,&pr);
					if (t->rc==TCL_OK && nr<2)
						t->rc = rprintf(t->intr,"%!bad ::wyrm::wif::protocol result",TCL_ERROR);
					if (t->rc==TCL_OK) {
						if (Tcl_GetIntFromObj(0,pr[0],&t->rc)!=TCL_OK) {
							t->rc = rprintf(t->intr,"%!bad ::wyrm::wif::protocol result",TCL_ERROR);
						}else if (t->rc!=TCL_OK) {
							Obj temp = incr(pr[1]); Tcl_SetObjResult(t->intr,temp); decr(temp);
						}else {
							t->vars = incr(Tcl_NewListObj(nr-2,pr+2));
						}
					}
				}else {
					Tcl_SetVar2Ex(t->intr,"line",0,t->line,0); decr(t->line); t->line = 0;
					t->rc = Tcl_EvalObjEx(t->intr,t->ps[i+2],0);
				}
				(*activeProtocol) = oactiveProtocol;
				state = variable(t,"state");
				if (t && streq(Tcl_GetString(state),"!QUIT!")) t->rc = TCL_BREAK;
				break;
			}
		}
		if (i>=t->ns) {
			t->rc = rprintf(t->intr,"%!no state was selected: %s",TCL_ERROR,state);
		}
		decr(t->line); t->line = 0;
	}
	if (async) {
		{
			Obj output = variable(t,"output");
			Obj callback = variable(t,"async");
			bool shared = Tcl_IsShared(callback) && (output || t->rc==TCL_ERROR);
			Obj async = shared ? incr(Tcl_DuplicateObj(callback)) : callback;
			if (output) Tcl_ListObjAppendElement(0,async,output);
			if (t->rc==TCL_ERROR) Tcl_ListObjAppendElement(0,async,Tcl_GetObjResult(t->intr));
			Tcl_EvalObjEx(t->intr,async,0);
			Tcl_RestoreResult(t->intr,&safe);
			if (shared) decr(async);
		}
	quit:
		Tcl_DeleteChannelHandler(t->channel,protocolTask,clientData);
		decr(t->scripts); decr(t->vars); dispose(t->label);
		Tcl_Release(t->intr);
		dispose(t);
		Tcl_ResetResult(t->intr);
	}else {
		if (t->rc==TCL_BREAK) t->rc = TCL_OK;
		if (t->rc==TCL_OK) {
			Obj output = variable(t,"output");
			if (output) Tcl_SetObjResult(t->intr,output); else Tcl_ResetResult(t->intr);
		}
	}
}

		

		
typedef struct {
	Intr intr; Tcl_Channel channel;
} ClosecloseTask;

static void closecloseTask(ClientData clientData) {
	ClosecloseTask *t = (ClosecloseTask*)clientData;
	if (!Tcl_InterpDeleted(t->intr)) {
		Tcl_UnregisterChannel(t->intr,t->channel);
	}
	Tcl_Release(t->intr);
	dispose(t);
}

		

static int uriassist(ClientData clientData,Intr intr,int N,Tcl_Obj *const P[]);

		

if {[catch {
		load $env(TCLLIBPATH)/wyrmwif[info sharedlibextension]
		load $env(TCLLIBPATH)/wyrmassoc[info sharedlibextension]
		namespace import wyrm::*
		set urispace [assoc new btree urispace.map]
		<Pattern constructors>
		<Generic URL>
		<Relative URL>
		<file: URL>
		<data: URL>
		<ftp: URL>
		<gopher: URL>
		<http: URL>
		<mailto: URL>
		<nntp: URL>
		<pop: POP3 mail URL>
		<channel: URI>
		<none: URI>
		<oav: URL>
		puts [btree compile $urispace staticUriSpace /%static/urispace.map]
		file delete $urispace
} rs]} {
	puts stderr $rs\n\n$::errorInfo
	exit 1
} else {
	exit 0
}

		

proc any characters {concat \[$characters\]*}
proc some characters {concat \[$characters\]+}
proc all {} {concat .*}
proc none characters {concat \[^$characters\]*}
proc one characters {concat \[$characters\]}
proc not characters {concat \[^$characters\]}
proc part {piece} {concat ($piece)}
proc opt piece {concat (?:$piece)?}
proc either args {concat (?:[join $args |])}

proc scheme scheme {concat ^[part $scheme]:}
proc host-address piece {opt //$piece}
	proc user-password-host-port {} {host-address [opt [user-password]@][host-port]}
	proc user-password-host {} {host-address [opt [user-password]@][host]}
	proc user-host-port {} {host-address [opt [user]@][host-port]}
	proc user-host {} {host-address [opt [user]@][host]}
		proc user {args} {concat [part [none @/[join $args {}]]]}
		proc AUTH {} {opt ";\[Aa\]\[Uu\]\[Tt\]\[Hh\]=[part [none @:/]]"}
		proc password {} {opt :[part [none @:/]]}
		proc user-password {} {concat [user :][password]}
		proc host {} {part [none "/;#?"]}
		proc host-port {} {concat [part [none "/;#:?"]][opt :[part [none "/;?#"]]]}
proc path {} {opt [opt /\[.\]/][part [none ";#?"]]}
proc parameter {args} {opt [part ";[none #?[join $args {}]]"]}
proc search {} {opt [one ?][part [none #]]}
proc fragment {} {opt #[part [all]]}
proc end {} {concat {$}}
proc mime-type {} {concat [opt [part [none "/;,"]]][opt /[part [none ";,"]]]}
proc data {} {opt ,[part [all]]}
proc tab {} {concat (?:%09|\t)}
proc gopher-query {} {opt [gtype][selector][gsearch]}
	proc gtype {} {concat /[part [not %]]}
	proc selector {} {part [none %]}
	proc gsearch {} {opt [tab][part [none %][gstring]]}
		proc gstring {} {opt [tab][part [none ";"]]}
proc newsgroup {} {part [none "/;@"]}
proc newsgroup-article-range {} {opt [newsgroup][opt /[article-number][opt -[article-number]]]}
	proc newsgroup {} {part {[^@/;]+}}
	proc article-number {} {part [some 0123456789*]}
proc article-name {} {opt [part [none {@;}]@[none {;}]]}
proc message {} {opt /[part [none ";"]]}

		

oav put $urispace uri.+parts {scheme user host port path parameter search fragment}
oav put $urispace uri.+pattern [scheme [any -+.a-zA-Z0-9]][user-host-port][path][parameter][search][fragment][end]
oav put $urispace uri.+generate {s:(//(s@)s(:s)h)sp(?r)(#s)}


<Open method>
<Get method>
<Put method>
<Delete method>
<Status method>
<Children method>
			
		

oav method $urispace uri.open {uri args} {
	set mode r; set pem 0640; set async ""; set loop ""; set channel ""; set oargs {}
	foreach {p v} $args {
		switch -- $p {
			-mode - -pem - -async - -loop {set [string range $p 1 end] $v}
			default {lappend oargs $p $v}
		}
	}
	switch $loop {
		open {error "no method to open [::wyrm::uri part $uri scheme] -mode $mode"}
		"" {set loop open}
	}
	switch $mode {
		r - RDONLY - "" {
			if {[string length $async]} {
				eval [list ::wyrm::uri get $uri -loop $loop -async [::wyrm::lambda {openAsyncScript data args} {
					if {[llength $args]} {
						eval $openAsyncScript {{}} $args
					} else {
						set channel [::wyrm::data read $data]
						fconfigure $channel -translation binary
						after idle $openAsyncScript $channel
					}
				} $async]] $oargs
				return ""
			} else {
				set channel [::wyrm::data read [eval [list ::wyrm::uri get $uri -loop $loop] $oargs]]
				fconfigure $channel -translation binary
				return $channel
			}
		}
		w - WRONLY {
			if {[string length $async]} {
				set channel [::wyrm::data write [::wyrm::lambda {uri pem errorScript data} {
					::wyrm::uri put $uri $data -pem $pem -async $errorScript
				} $uri $pem]]
				eval [list ::wyrm::data argument $channel [::wyrm::lambda {openAsyncScript channel args} {
					if {[llength $args]} {
						after idle $openAsyncScript $channel $args
					}
				} $async $channel]] $oargs
				fconfigure $channel -translation binary
				after idle $async $channel
				return ""
			} else {
				set channel [::wyrm::data write [::wyrm::lambda {uri pem loop data oargs} {
					eval [list ::wyrm::uri put $uri $data -pem $pem -loop $loop] $oargs
				} $uri $pem $loop $oargs]]
				fconfigure $channel -translation binary
				return $channel
			}
		}
		default {
			error "cannot open with mode $mode"
		}
	}
}

		

oav method $urispace uri.get {uri args} {
	set async ""; set loop ""; set oargs {}
	foreach {p v} $args {
		switch -- $p {
			-async - -loop {set [string range $p 1 end] $v}
			default {lappend oargs $p $v}
		}
	}
	switch $loop {
		get {error "no method to get [::wyrm::uri part $uri scheme]"}
		"" {set loop get}
	}
	if {[string length $async]>0} {
		eval [list ::wyrm::uri open $uri -mode r -async [::wyrm::lambda {async input args} {
			if {[llength $args]} {
				after idle $async {{}} $args
			} else {
				set output [::wyrm::data write [::wyrm::lambda {async args} {
					switch [llength $args] {
						1 {after idle $async $args}
						2 {after idle $async [list [lindex $args 1] [lindex $args 0]]}
					}
				} $async]]
				fconfigure $output -translation binary
				fcopy $input $output -command [::wyrm::lambda {input output count args} {
					if {[llength $args]} {
						::wyrm::data argument $output [lindex $args 0]
					}
					catch {close $input}
					catch {close $output}
				} $input $output]
			}
		} $async]] $oargs
		return ""
	} else {
		set  channel [eval [list ::wyrm::uri open $uri -mode r -loop $loop] $oargs]
		set rc [catch {read $channel} rs]; set ei $::errorInfo; set ec $::errorCode
		if {$rc} {
			catch {close $channel}
			error $rs $ei $ec
		} else {
			close $channel
			return $rs
		}
	}
}

		

oav method $urispace uri.put {uri data args} {
	set pem 0640; set async ""; set loop ""; set oargs {}
	foreach {p v} $args {
		switch -- $p {
			-pem - -async - -loop {set [string range $p 1 end] $v}
			default {lappend oargs $p $v}
		}
	}
	switch $loop {
		put {error "no method to put [::wyrm::uri part $uri scheme]"}
		"" {set loop put}
	}
	if {[string length $async]} {
		eval [list ::wyrm::uri open $uri -mode w -pem $pem -loop $loop -async [::wyrm::lambda {data async output args} {
			if {[llength $args]} {
				after idle $async $args
			} else {
				set input [::wyrm::data read $data]
				fconfigure $input -translation binary
				fcopy $input $output -command [::wyrm::lambda {input output async count args} {
					catch {close $input}
					catch {close $output}
					after idle $async $args
				} $input $output $async]
			}
		} $data $async]] $oargs
		return ""
	} else {
		set channel [eval [list ::wyrm::uri open $uri -mode w -pem $pem -loop $loop] $oargs]
		set rc [catch {::wyrm::uriassist puts $channel $data} rs]; set ei $::errorInfo; set ec $::errorCode
		if {$rc} {
			catch {close $channel}
			error $rs $ei $ec
		} else {
			close $channel
			return $rs
		}
	}
}

		

oav method $urispace uri.delete	{uri args} {
	set async ""; set r 0
	foreach {p v} $args {
		switch -- $p {
			-async - -r {set [string range $p 1 end] $v}
			default {error "unknown delete option: $p"}
		}
	}
	if {[string length $async]} {
		after idle $async [list "cannot delete: [::wyrm::uri part $uri scheme]"]
	} else {
		error "cannot delete: [::wyrm::uri part $uri scheme]"
	}
}

		

oav method $urispace uri.status {uri args} {
	set async ""
	array set status {}
	foreach {p v} $args {
		switch -- $p {
			-async {set async $v}
			default {set status($p) $v}
		}
	}
	array set status [list exists 0 uri $uri]
	if {[string length $async]} {
		after idle $async [list $status]
		return ""
	} else {
		return [array get status]
	}
}

		

oav method $urispace uri.children {uri args} {
	set async ""
	foreach {p v} $args {
		switch -- $p {
			-async {set async $v}
			default {error "unknown children option: $p"}
		}
	}
	if {[string length $async]} {
		after idle $async {{}}
		return ""
	} else {
		return {}
	}
}

		

oav put $urispace uri.(relative).+parts {user host port path parameter search fragment}
oav put $urispace uri.(relative).+pattern ^[user-host-port][path][parameter][search][fragment][end]
oav put $urispace uri.(relative).+generate {x(//(s@)s(:s)h)sp(?r)(#s)}

		

oav delegate $urispace uri.(relative) uri.file

		

oav put $urispace uri.file.+parts {scheme user host path parameter}
oav put $urispace uri.file.+pattern [scheme file][user-host][path][parameter][end]
oav put $urispace uri.file.+generate {s:(//(s@)sh)sp}

<file: Open method>
<file: Delete method>
<file: Status method>
<file: Children method>

		

oav method $urispace uri.file.open {uri args} {
	set mode r; set pem 0640; set async ""; set loop ""; set channel ""
	foreach {p v} $args {
		switch -- $p {
			-mode - -pem - -async - -loop {set [string range $p 1 end] $v}
			default {error "unknown open option: $p"}
		}
	}
	set rc [catch {
		set channel [open [::wyrm::uri part $uri path] $mode $pem]
		foreach option {blocking buffering buffersize encoding eofchar translation} {
			if {![catch {::wyrm::uri part $uri ";$option"} value]} {
				fconfigure $channel -$option $value
			}
		}
	} rs]
	if {[string length $async]} {
		lappend async $channel
		if {$rc} {
			catch {close $channel}
			lappend async $rs
		}
		after idle $async
		return ""
	} elseif {$rc} {
		set ei $::errorInfo; set ec $::errorInfo
		catch {close $channel}
		error $rs $ei $ec
	} else {
		return $channel
	}
}

		

oav method $urispace uri.file.delete {uri args} {
	set async ""; set r 0
	foreach {p v} $args {
		switch -- $p {
			-async - -r {set [string range $p 1 end] $v}
			default {error "unknown open option: $p"}
		}
	}
	set rc [catch {
		if {$r} {
			file delete -force [::wyrm::uri part $uri path]
		} else {
			file delete [::wyrm::uri part $uri path]
		}
	} rs]
	if {[string length $async]} {
		if {$rc} {
			lappend async $rs
		}
		after idle $async
		return ""
	} elseif {$rc} {
		error $rs $::errorInfo $::errorInfo
	} else {
		return ""
	}
}

		

oav method $urispace uri.file.status {uri args} {
	set async ""
	array set status {}
	foreach {p v} $args {
		switch -- $p {
			-async {set async $v}
			default {set status($p) $v}
		}
	}
	set path [::wyrm::uri part $uri path]
	if {[file exists $path]} {
		set rc [catch {file stat $path status} rs]
		if {$rc} {set status(error-message) $rs}
		array set status [list exists 1 uri $uri]
	} else {
		array set status [list exists 0 uri $uri]
	}
	if {[string length $async]} {
		after idle $async [list $status]
		return ""
	} else {
		return [array get status]
	}
}

		

oav method $urispace uri.file.children {uri args} {
	set async ""
	foreach {p v} $args {
		switch -- $p {
			-async {set async $v}
			default {error "unknown children option: $p"}
		}
	}
	set rc [catch {glob [file join] [::wyrm::uri part $uri path] *} rs]
	if {[string length $async]} {
		if {$rc} {lappend async {}}
		lappend async $rs
		after idle $async
		return ""
	} elseif {$rc} {
		error $rs $::errorInfo $::errorInfo
	} else {
		return $rs
	}
}

		

oav put $urispace uri.data.+parts {scheme type subtype parameter data}
oav put $urispace uri.data.+pattern [scheme data][mime-type][parameter ,][data][end]
oav put $urispace uri.data.+generate {s:s(/s)p(,s)}

<data: Get method>
<data: Status method>

		

oav method $urispace uri.data.get {uri args} {
	set async ""; set loop ""
	foreach {p v} $args {
		switch -- $p {
			-async - -loop {set [string range $p 1 end] $v}
			default {error "unknown get option: $p"}
		}
	}
	if {[catch {::wyrm::uri part $uri ";base64"} value]} {set value 0}
	set data [::wyrm::uri part $uri data]
	if {![string equal $value 0]} {
		set data [::wyrm::kwbase64 decode $data]
	}
	if {[string length $async]} {
		after idle $async [list $data]
		set data ""
	}
	return $data
}

		

oav method $urispace uri.data.status {uri args} {
	set async ""
	array set status {}
	foreach {p v} $args {
		switch -- $p {
			-async {set async $v}
			default {set status($p) $v}
		}
	}
	array set status [list exists 1 uri $uri mimetype [::wyrm::uri part $uri type]/[::wyrm::uri part $uri subtype]]
	set data [array get result]
	if {[string length $async]} {
		after idle $async [list $data]
		set data ""
	}
	return $data
}

		

oav put $urispace uri.ftp.+parts {scheme user password host port path parameter}
oav put $urispace uri.ftp.+pattern [scheme ftp][user-password-host-port][path][parameter][end]
oav put $urispace uri.ftp.+generate {s:(//(s(:s)@)s(:s)h)sp(#s)}

<ftp: Open method>
<ftp: Delete method>
<ftp: Status method>
<ftp: Children method>

		

USER 2* {
	::wyrm::uriassist puts $channel "USER $user"
	set state PASS
}
PASS 3* {
	::wyrm::uriassist puts $channel "PASS $pass"
	set state begin
}
PASS 2* {
	::wyrm::uriassist puts $channel NOOP
	set state begin
}
begin 2[0-9][0-9]-* {
	set state prelude
}
prelude 2* {
	::wyrm::uriassist puts $channel "NOOP"
	set state begin
}
prelude * {
	;
}

		

quit * {
	;
}
!quit EOF {
	::wyrm::uriassist log CLOSE
	close $channel
	set state !QUIT!
}
!* ERR* {
	close $channel
	error "I/O $line"
}
!* EOF {
	close $channel
	error {unexpected end of session}
}
* [13]* {
	;
}
* [45]* {
	close $channel
	error $line
}
* * {
	close $channel
	error "unexpected session response: $line"
}

		

oav method $urispace uri.ftp.open {uri args} {
	set mode r; set pem ""; set async ""; set loop ""; set channel ""; set log 0
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-mode - -pem - -async - -loop - -log {set [string range $p 1 end] $v}
			default {error "unknown open option: $p"}
		}
	}
	set user anonymous; set password nobody@nowhere.net; set host ""; set port 21; set path ""
	foreach {p v} [::wyrm::uri part $uri] {set $p $v}
	if {[catch {::wyrm::uri part $uri ";type"} type]} {set type i}
	set type [string toupper $type]
	set configure {}
	foreach option {blocking buffering buffersize encoding eofchar translation} {
		if {![catch {::wyrm::uri part $uri ";$option"} value]} {
			lappend configure -$option $value
		}
	}
	if {[lsearch -exact $configure -translation]<0} {
		switch $type {
			A - D {lappend configure -translation crlf}
			I {lappend configure -translation auto}
		}
	}
	switch $mode {
		r - RDONLY - "" {
			if {[string equal $type D]} {
				set transfer LIST
			} else {
				set transfer RETR
			}
			set dirs {}
			set pem ""
		}
		w - WRONLY {
			set transfer STOR
			set dirs [file split [file dirname $path]]
		}
		a - APPEND {
			set transfer APPE
			set dirs [file split [file dirname $path]]
		}
		default {
			error "cannot open with mode $mode"
		}
	}
	if {[string equal $type D]} {set type A}
	if {[llength $dirs]>0 && ![string equal [lindex $dirs 0] /]} {
		set dirs [linsert $dirs 0 .]
	}
	if {[catch {
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async {} $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	return [
		::wyrm::uriassist protocol $channel \
					state USER channel $channel user $user pass $password \
					type $type dirs $dirs configure $configure pem $pem transfer $transfer \
					path $path async $async logging $log output "" \
		{
			<ftp Authorisation>
			begin 2* {
				::wyrm::uriassist puts $channel "TYPE $type"
				if {[llength $dirs]} {
					set state MKD
				} else {
					set state PASV
				}
			}
			MKD [25]* {
				set dirs [::wyrm::setp {root piece} $dirs]
				set root [file join $root $piece]
				::wyrm::uriassist puts $channel "MKD $root"
				if {[string length $pem]} {
					set dirs [linsert $dirs 0 $root]
					set state PEMD
				} elseif {[llength $dirs]} {
					set dirs [linsert $dirs 0 $root]
					set state MKD
				} else {
					set state PASV
				}
			}
			PEMD 2* {
				::wyrm::setp root $dirs
				set pemd [format %03o [expr {(($pem&0444)>>2)|$pem}]]
				::wyrm::uriassist puts $channel "SITE CHMOD $pemd $root"
				if {[llength $dirs]>1} {
					set state MKD
				} else {
					set state PASV
				}
			}
			PEMD 5* {
				::wyrm::uriassist puts $channel "NOOP"
				if {[llength $dirs]>1} {
					set state MKD
				} else {
					set state PASV
				}
			}
			PASV [25]* {
				::wyrm::uriassist puts $channel "PASV"
				set state FILE
			}
			FILE 2* {
				if {![regexp {\((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)} $line - a b c d p q]} {
					error "missing socket description in response to PASV: $line"
				}
				set port [expr {($p<<8)+$q}]
				::wyrm::uriassist log "DATA CONNECT $a.$b.$c.$d $port"
				set output [socket $a.$b.$c.$d $port]
				if {[llength $configure]} {eval [list fconfigure $output] $configure}
				::wyrm::uriassist puts $channel "$transfer $path"
				::wyrm::uriassist closeclose $output $channel
				set state transfer
			}
			transfer 1* {
				if {[string length $pem]} {
					set pem [format %03o $pem]
					::wyrm::uriassist puts $channel "PUT SITE CHMOD $pem $path"
				}
				set state !QUIT!
			}
			<Terminate Telnet session>
		}
	]
}

		

oav method $urispace uri.ftp.delete	{uri args} {
	set async ""; set r 0; set log 0
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-async - -r - -log {set [string range $p 1 end] $v}
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			default {error "unknown delete option: $p"}
		}
	}
	set user anonymous; set password nobody@nowhere.net; set host ""; set port 21; set path ""
	foreach {p v} [::wyrm::uri part $uri] {set $p $v}
	if {[catch {
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	::wyrm::vprioq new work -id $path 0 [list [expr {!$r}] $path]
	::wyrm::uriassist protocol $channel \
			state USER channel $channel data "" user $user \
			pass $password r $r work $work phase "" path "" \
			async $async logging $log \
	{
		<ftp Authorisation>
		begin 2* {
			if {[::wyrm::vprioq dequeue work task est; set est]} {
				::wyrm::setp {phase path} $task
				::wyrm::uriassist puts $channel "DELE $path"
				set state deleted
			} else {
				::wyrm::uriassist puts $channel "QUIT"
				set state quit
			}
		}
		* 550* {
			switch $phase {
				0 {
					::wyrm::uriassist puts $channel "PASV"
					vprioq enqueuebefore work 0 [list 1 $path]
					set state NLST
				}
				1 {
					close $channel
					error $line
				}
			}
		}
		deleted 2* {
			if {[::wyrm::vprioq dequeue work task est; set est]} {
				::wyrm::setp {phase path} $task
				::wyrm::uriassist puts $channel "DELE $path"
				set state deleted
			} else {
				::wyrm::uriassist puts $channel "QUIT"
				set state quit
			}
		}
		deleted 5* {
			::wyrm::uriassist puts $channel "RMD $path"
			set state removing
		}
		removing [25]* {
			if {[::wyrm::vprioq dequeue work task est; set est]} {
				::wyrm::setp {phase path} $task
				::wyrm::uriassist puts $channel "DELE $path"
				set state deleted
			} else {
				::wyrm::uriassist puts $channel "QUIT"
				set state quit
			}
		}
		NLST 2* {
			if {![regexp {\((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)} $line - a b c d p q]} {
				error "missing socket description in response to PASV: $line"
			}
			set port [expr {($p<<8)+$q}]
			::wyrm::uriassist log "DATA CONNECT $a.$b.$c.$d $port"
			set data [socket $a.$b.$c.$d $port]
			fconfigure $data -translation {crlf crlf}
			::wyrm::uriassist puts $channel "NLST $path"
			set state start-nlst
		}
		start-nlst 1* {
			::wyrm::uriassist channel $data DATA
			set state nlst
		}
		nlst * {
			vprioq enqueuebefore work -id $line 0 [list 0 $line]
		}
		!nlst EOF {
			::wyrm::uriassist log "DATA CLOSE"
			::wyrm::uriassist channel $channel GET
			close $data
			set state begin
		}
		!nlst ERR* {
			close $data
			close $channel
			error "I/O $line"
		}
		<Terminate Telnet session>
	}
	return ""
}

		

oav method $urispace uri.ftp.status {uri args} {
	set async ""; set log 0
	set status {}
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -log {set [string range $p 1 end] $v}
			default {vassoc put status $p $v}
		}
	}
	vassoc put status exists 0
	vassoc put status uri $uri
	set user anonymous; set password nobody@nowhere.net; set host ""; set port 21; set path ""
	foreach {p v} [::wyrm::uri part $uri] {set $p $v}
	if {[catch {
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async $status $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	return [
		::wyrm::uriassist protocol $channel \
					state USER channel $channel user $user pass $password uri $uri \
					path $path async $async logging $log output $status \
		{
			<ftp Authorisation>
			begin 2* {
				::wyrm::uriassist puts $channel "MLST $path"
				set state mlst-start
			}
			mlst-start 2[0-9][0-9]-* {
				set state mlst-text
			}
			mlst-text {[   A-Za-z]*} {
				foreach fact [split $line ";"] {
					if {![regexp {^([^=]+)=(.*)$} $fact - factname f]} continue
					set factname [string tolower [string trim $factname]]
					set fact [string trim $f]
					switch $factname {
						modify - create {
							regexp {^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\.\d+)?$} $fact - y m d H M S
							set time [clock scan "${y}${m}${d}T${H}${M}${S}" -gmt 1]
							::wyrm::vassoc put output [string index $factname 0]time $time
						}
						unique {::wyrm::vassoc put output ino $fact}
						type {
							if {[string match *dir $fact]} {set fact directory}
							::wyrm::vassoc put output type $fact
						}
						perm {
							set mode 0
							foreach f [split $fact {}] {
								switch -- [string tolower $f] {
									a {set mode [expr {$mode|0200}]}
									c {set mode [expr {$mode|0200}]}
									d {set mode [expr {$mode|0200}]}
									e {set mode [expr {$mode|0400}]}
									f {set mode [expr {$mode|0200}]}
									l {set mode [expr {$mode|0100}]}
									m {set mode [expr {$mode|0200}]}
									p {set mode [expr {$mode|0200}]}
									r {set mode [expr {$mode|0400}]}
									w {set mode [expr {$mode|0200}]}
								}
							}
							::wyrm::vassoc put output mode $mode
							::wyrm::vassoc put output $factname $fact
						}
						default {::wyrm::vassoc put output $factname $fact}
					}
				}
				set state mlst-text
			}
			mlst-text 2* {
				::wyrm::vassoc put output uri $uri
				::wyrm::vassoc put output exists 1
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			mlst-start 5* {
				::wyrm::uriassist puts $channel "STAT $path"
				set state stat-start
			}
			stat-start 2[0-9][0-9]-* {
				set state stat-text
			}
			stat-text {[   A-Za-z]*} {
				;
			}
			stat-text 2* {
				::wyrm::vassoc put output uri $uri
				::wyrm::vassoc put output exists 1
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			stat-start 5* {
				::wyrm::vassoc put output uri $uri
				::wyrm::vassoc put output exists 0
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			<Terminate Telnet session>
		}
	]
}

		

oav method $urispace uri.ftp.children {uri args} {
	set async ""; set log 0
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -log {set [string range $p 1 end] $v}
			default {error "unknown children option: $p"}
		}
	}
	set user anonymous; set password nobody@nowhere.net; set host ""; set port 21; set path ""
	foreach {p v} [::wyrm::uri part $uri] {set $p $v}
	if {[catch {
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async {} $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	return [
		::wyrm::uriassist protocol $channel \
					state USER channel $channel user $user pass $password \
					path $path async $async logging $log output "" uri $uri \
		{
			<ftp Authorisation>
			begin 2* {
				::wyrm::uriassist puts $channel "PASV"
				set state NLST
			}
			NLST 2* {
				if {![regexp {\((\d+),(\d+),(\d+),(\d+),(\d+),(\d+)\)} $line - a b c d p q]} {
					::wyrm::uriassist parameter {}
					error "missing socket description in response to PASV: $line"
				}
				set port [expr {($p<<8)+$q}]
				::wyrm::uriassist log "DATA CONNECT $a.$b.$c.$d $port"
				set data [socket $a.$b.$c.$d $port]
				fconfigure $data -translation {crlf crlf}
				::wyrm::uriassist puts $channel "NLST $path"
				set state start-nlst
			}
			start-nlst 1* {
				::wyrm::uriassist channel $data DATA
				set state nlst
			}
			nlst * {
				lappend output [::wyrm::uri part $uri path $line]
			}
			!nlst EOF {
				::wyrm::uriassist log "DATA CLOSE"
				close $data
				::wyrm::uriassist channel $channel GET
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			!nlst ERR* {
				close $data
				close $channel
				error "I/O $line"
			}
			<Terminate Telnet session>
		}
	]
}

		

oav put $urispace uri.gopher.+parts {scheme host port gtype selector gsearch gstring parameter}
oav put $urispace uri.gopher.+pattern [scheme gopher][host-port][gopher-query][parameter][end]
oav put $urispace uri.gopher.+generate {s:(//s(:s))(/ss(%09s(%09s)))p}

		

oav put $urispace uri.http.+parts {scheme host port path parameter search fragment}
oav put $urispace uri.http.+pattern [scheme http][host-address [host-port]][path][parameter][search][fragment][end]
oav put $urispace uri.http.+generate {s:(//s(:s)h)sp(?r)(#s)}
oav put $urispace uri.http.+defaultport 80
oav delegate $urispace uri.https uri.http
oav put $urispace uri.https.+parts {scheme host port path parameter search fragment}
oav put $urispace uri.https.+pattern [scheme https][host-address [host-port]][path][parameter][search][fragment][end]
oav put $urispace uri.https.+generate {s:(//s(:s)h)sp(?r)(#s)}
oav put $urispace uri.https.+defaultport 443

<http: Get method>
<http: Post method>
<http: Status method>

		

oav method $urispace uri.http.get {uri args} {
	package require http
	set asynchronous 0
	set async ""
	set headers {}
	set options {}
	set header ""
	foreach {p v} $args {
		switch -glob -- $p {
			-async {set async $v; set asynchronous 1}
			-command {lappend options $p $v; set asynchronous 1}
			-header {set header $v}
			-loop {;}
			-* {lappend options $p $v}
			+* {lappend headers [string range $p 1 end] $v}
			* {lappend headers $p $v}
		}
	}
	if {[llength $headers]} {
		lappend options -headers $headers
	}
	if {[string length $async]} {
		lappend options -command [::wyrm::lambda {async header token} {
			upvar #0 $token state
			if {[catch {lappend async $state(body)}]} {lappend async {}}
			if {[string length $header]} {
				upvar #0 $header h; set $h {}
				foreach {p v} [array get state] {
					switch $p {
						charset - coding - currentsize - error - http - posterror - status - totalsize - type - url {
							lappend h $p $v
						}
						meta {
							foreach {P V} $v {lappend h $P $V}
						}
					}
				}
			}
			if {[regexp {HTTP/\d+[.]\d+ (\d\d\d)\s*(.*)} $state(http) - code message]} {
				if {$code>=400} {
					lappend async "$code $message"
				}
			} else {
				lappend async $state(status)
			}
			::http::cleanup $token
			eval $async
		} $async $header]
	}
	if {[string length $async]} {
		if {[catch {eval [list ::http::geturl $uri] $options} rs]} {
			lappend async {} $rs
			after idle $async
		}
		return ""
	} elseif {$asynchronous} {
		return [eval [list ::http::geturl $uri] $options]
	} else {
		set token [eval [list ::http::geturl $uri] $options]
		upvar #0 $token state
		if {[string length $header]} {
			upvar 1 $header h; set $h {}
			foreach {p v} [array get state] {
				switch $p {
					charset - coding - currentsize - error - http - posterror - status - totalsize - type - url {
						lappend h $p $v
					}
					meta {
						foreach {P V} $v {lappend h $P $V}
					}
				}
			}
		}
		if {[regexp {HTTP/\d+[.]\d+ (\d\d\d)\s*(.*)} $state(http) - code message]} {
			if {$code>=400} {
				catch {::http::cleanup $token}
				error "$code $message"
			} else {
				set block $state(body)
				::http::cleanup $token
				return $block
			}
		} else {
			set em $state(status)
			catch {::http::cleanup $token}
			error $em
		}
	}
}

		

oav method $urispace uri.http.post {uri data args} {
	package require http
	set asynchronous 0
	set typed 0
	set async ""
	set headers {}
	set options {}
	set header ""
	foreach {p v} $args {
		switch -glob -- $p {
			-async {set async $v; set asynchronous 1}
			-command {lappend options $p $v; set asynchronous 1}
			-header {set header $v}
			-postblocksize {lappend options -queryblocksize $v}
			-postprogress {lappend options -queryprogress $v}
			-type {lappend options -type $v; set typed 1}
			-loop {;}
			-* {lappend options $p $v}
			+* {lappend headers [string range $p 1 end] $v}
			* {lappend headers $p $v}
		}
	}
	if {[catch {llength $data} n]} {set n 1}
	if {!$typed && $n%2==0} {set data [eval ::http::formatQuery $data]}
	lappend options -query $data
	if {[llength $headers]} {
		lappend options -headers $headers
	}
	if {[string length $async]} {
		lappend options -command [::wyrm::lambda {async header token} {
			upvar #0 $token state
			if {[catch {lappend async $state(body)}]} {lappend async {}}
			if {[string length $header]} {
				upvar #0 $header h; set $h {}
				foreach {p v} [array get state] {
					switch $p {
						charset - coding - currentsize - error - http - posterror - status - totalsize - type - url {
							lappend h $p $v
						}
						meta {
							foreach {P V} $v {lappend h $P $V}
						}
					}
				}
			}
			if {[regexp {HTTP/\d+[.]\d+ (\d\d\d)\s*(.*)} $state(http) - code message]} {
				if {$code>=400} {
					lappend async "$code $message"
				}
			} else {
				lappend async $state(status)
			}
			::http::cleanup $token
			eval $async
		} $async $header]
	}
	if {[string length $async]} {
		if {[catch {eval [list ::http::geturl $uri] $options} rs]} {
			lappend async {} $rs
			after idle $async
		}
		return ""
	} elseif {$asynchronous} {
		return [eval [list ::http::geturl $uri] $options]
	} else {
		set token [eval [list ::http::geturl $uri] $options]
		upvar #0 $token state
		if {[string length $header]} {
			upvar 1 $header h; set $h {}
			foreach {p v} [array get state] {
				switch $p {
					charset - coding - currentsize - error - http - posterror - status - totalsize - type - url {
						lappend h $p $v
					}
					meta {
						foreach {P V} $v {lappend h $P $V}
					}
				}
			}
		}
		if {[regexp {HTTP/\d+[.]\d+ (\d\d\d)\s*(.*)} $state(http) - code message]} {
			if {$code>=400} {
				catch {::http::cleanup $token}
				error "$code $message"
			} else {
				set block $state(body)
				::http::cleanup $token
				return $block
			}
		} else {
			catch {::http::cleanup $token}
			error {missing or ill-formatted HTTP response}
		}
	}
}

		

oav method $urispace uri.http.status {uri args} {
	package require http
	set asynchronous 0
	set async ""
	set status {}
	set headers {}
	set options {}
	foreach {p v} $args {
		switch -glob -- $p {
			-async {set async $v; set asynchronous 1}
			-command {lappend options $p $v; set asynchronous 1}
			-loop {;}
			-* {lappend options $p $v}
			+* {lappend headers [string range $p 1 end] $v}
			default {::wyrm::vassoc put status $p $v}
		}
	}
	lappend options -validate 1
	if {[llength $headers]} {
		lappend options -headers $headers
	}
	if {[string length $async]} {
		lappend options -command [::wyrm::lambda {async uri status token} {
			upvar #0 $token state
			foreach {p v} [array get state] {
				switch -- $p {
					charset - coding - currentsize - error - http - posterror - status - totalsize - url {
						::wyrm::vassoc put status $p $v
					}
					type {
						::wyrm::vassoc put status $p $v
						::wyrm::vassoc put status mimetype $v
					}
					meta {
						foreach {P V} $v {::wyrm::vassoc put status $p $v}
					}
				}
			}
			::wyrm::vassoc put status uri $uri
			::wyrm::vassoc put status exists $uri
			if {[regexp {HTTP/\d+[.]\d+ (\d\d\d)\s*(.*)} $state(http) - code message]} {
				::wyrm::vassoc put status exists [expr {$code<400}]
			} else {
				::wyrm::vassoc put status exists 0
			}
			::http::cleanup $token
			lappend async $status
			eval $async
		} $async $uri $status]
	}
	if {[string length $async]} {
		if {[catch {eval [list ::http::geturl $uri] $options} rs]} {
			lappend async {} $rs
			after idle $async
		}
		return ""
	} elseif {$asynchronous} {
		return [eval [list ::http::geturl $uri] $options]
	} else {
		set token [eval [list ::http::geturl $uri] $options]
		upvar #0 $token state
		foreach {p v} [array get state] {
			switch -- $p {
				charset - coding - currentsize - error - http - posterror - status - totalsize - url {
					::wyrm::vassoc put status $p $v
				}
				type {
					::wyrm::vassoc put status $p $v
					::wyrm::vassoc put status mimetype $v
				}
				meta {
					foreach {P V} $v {::wyrm::vassoc put status $P $V}
				}
			}
		}
		::wyrm::vassoc put status uri $uri
		::wyrm::vassoc put status exists $uri
		if {[regexp {HTTP/\d+[.]\d+ (\d\d\d)\s*(.*)} $state(http) - code message]} {
			::wyrm::vassoc put status exists [expr {$code<400}]
		} else {
			::wyrm::vassoc put status exists 0
		}
		::http::cleanup $token
		return $status
	}
}

		

oav put $urispace uri.mailto.+parts {scheme user host port parameter headers}
oav put $urispace uri.mailto.+pattern [scheme mailto][opt [user]@][host-port][parameter][search][end]
oav put $urispace uri.mailto.+generate {s:(s@)s(:s)p(?r)}
<mailto: Resolve method>
<mailto: Put method>

		

oav method $urispace uri.mailto.put {uri data args} {
	set async ""; set loop ""; set log 0
	foreach {p v} $args {
		switch -- $p {
			-pem {;}
			-async - -loop - -log {set [string range $p 1 end] $v}
			default {error "unknown put option: $p"}
		}
	}
	set user ""; set host ""; set port 25; set parameter ""; set headers ""
	foreach {p x} [::wyrm::uri part $uri] {set $p $x}
	if {[catch {::wyrm::uri part $uri ";relay"} relay]} {set relay ""}
	if {[catch {::wyrm::uri part $uri ";sender"} sender]} {set sender "unknown@nowhere.com"}
	if {[string length $user$host]} {
		set receiver $user@$host
	} else {
		set receiver {}
	}
	set head ""
	set body ""
	foreach header [split [string map [list \x0d\x0a \n \x0d \n] $headers] &] {
		::wyrm::setp {label content} [split $header =]
		if {[string equal -nocase $label body]} {
			append body $content\n
		} else {
			lappend head "[string totitle $label]: $content"
		}
	}
	if {[string first \n\n $data]>=0 && [string first : [lindex [split $data \n] 0]] > 0} {
		set blank 0
		foreach line [split $data \n] {
			if {$blank} {
				append body $line\n
			} elseif {[string length $line]==0} {
				set blank 1
			} else {
				lappend head $line
			}
		}
	} else {
		append body $data\n
	}
	foreach line $head {
		regexp {^([^:]+):(.*)$} $line - label content
		set label [string tolower $label]
		switch -- $label {
			to - resent-to - cc - resent-cc - bcc - resent-bcc - from - sender {
				set addrs {}
				foreach addr [split $content ,] {
					lappend a [string trim $addr]
				}
			}
		}
		switch $label {
			to - resent-to - cc - resent-cc - bcc - resent-bcc {
				set receiver [concat $receiver $addrs]
			}
			from - sender {
				set sender [lindex $addrs 0]
			}
		}
	}
	set message [string trim [string map {\n. \n..} \n[join $head \n]\n\n$body]]
	if {[catch {
		if {![string length $relay]} {
			set maxprio 0
			foreach addr $receiver {
				if {[regexp {([^<@]+@[^>]+)} $addr - host]} {
					foreach {prio host} [::wyrm::uri resolve mailto:$host MX] {
						if {$prio>$maxprio} {
							set maxprio $prio; set relay $host
						}
					}
				}
			}
		}
		if {![string length $relay]} {
			set relay [uri part [lindex mailto:$receiver 0] host]
		}
		if {$log} {puts stderr "CONNECT $relay $port"}
		set channel [socket $relay $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	::wyrm::uriassist protocol $channel \
			state HELO channel $channel relay $relay \
			sender $sender receiver $receiver message $message \
			async $async logging $log \
	{
		HELO 2* {
			::wyrm::uriassist puts $channel "HELO $relay"
			set state FROM
		}
		FROM 250* {
			::wyrm::uriassist puts $channel "MAIL FROM: <[string trim $sender <>]>"
			set state RCPT
		}
		FROM 2* {
			;
		}
		RCPT 2* {
			set receiver [::wyrm::setp addr $receiver]
			::wyrm::uriassist puts $channel "RCPT TO: <[string trim $addr <>]>"
			if {[llength $receiver]} {
				set state RCPT
			} else {
				set state DATA
			}
		}
		DATA 2* {
			::wyrm::uriassist puts $channel "DATA"
			set state send
		}
		send 3* {
			::wyrm::uriassist puts $channel "$message\n."
			set state QUIT
		}
		QUIT 2* {
			::wyrm::uriassist puts $channel "QUIT"
			set state quit
		}
		<Terminate Telnet session>
	}
	return ""
}

		

oav method $urispace uri.resolve {uri args} {
	set id [expr {[clock clicks]&0xFFFF}]
	set op 0
	set rd 1
	set dns {}
	set type 15
	set class 255
	set retry 5
	set pause 500
	while {[llength $args]} {
		set args [::wyrm::setp arg $args]
		switch -- [string tolower $arg] {
			in {set class 1} cs {set class 2} ch {set class 3} hs {set class 4} any {set class 255}
			a {set type 1} ns {set type 2} md  {set type 3} mf {set type 4} cname {set type 5}
			soa {set type 6} mb {set type 7} mg {set type 8} mr {set type 9} null {set type 10}
			wks {set type 11} ptr {set type 12} hinfo {set type 13} minfo {set type 14}
			mx {set type 15} txt {set type 16} afxr {set type 252} mailb {set type 253}
			maila {set type 254} * {set type 255}
			query {set op 0} iquery {set op 1} status {set op 2}
			dns - -dns {set args [::wyrm::setp ipa $args]; lappend dna $ipa}
			async - -async {set args [::wyrm::setp async $args]}
			default {error "unknown resolve parameter: $arg"}
		}
	}
	set format SSSSSSS
	set l 12
	set argv [list $id [expr {((15&$op)<<12)|((1&$rd)<<8)}] 1 0 0 0]
	foreach piece [split [::wyrm::uri part $uri host] .] {
		append format ca[string length $piece]
		incr l [expr {[string length $piece]+1}]
		lappend argv [string length $piece] $piece
	}
	append format cSS
	incr l 5
	lappend argv 0 $type $class
	set query [eval [list binary format $format $l] $argv]

	catch {
		set channel [open /etc/resolv.conf]
		while {[gets $channel line]>=0} {
			if {[regexp {nameserver\s+(\d+[.]\d+[.]\d+[.]\d+)} $line - addr]} {
				lappend dns $addr
			}
		}
	}
	catch {close $channel}
	lappend dns 216.154.202.3
	for {set answer {}; set try 1} {$try<=$retry && [llength $answer]==0} {incr try} {
		if {$try>1} {
			after $pause
		}
		foreach server $dns {
			set channel [socket $dns 53]
			fconfigure $channel \
					-translation binary \
					-blocking 0
			puts -nonewline $channel $query
			flush $channel
			for {set M ""; set to 1} {[string length $M<2] && $to<=50} {incr to} {
				if {$to>1} {update; after 50}
				append M [read $channel [expr {2-[string length $M]}]]
			}
			if {[string length $M]<2} continue
			binary scan $M S m
			for {set response ""; set to 1} {[string length $response<$m] && $to<=50} {incr to} {
				if {$to>1} {update; after 50}
				append response [read $channel [expr {$m-[string length $response]}]]
			}
			if {[string length $response]<$m} continue
			binary scan $response SSSSSS id word querycount answercount nscount arcount
			if {!$answercount} continue
			set o 12
			switch [expr {15 & ($word)}] {
				0 {;}
				1 {error {dns format error}}
				2 {error {dns server failure}}
				3 {error {dnsname error}}
				4 {error {dns not implemented}}
				5 {error {dns refused}}
				default {error "dns error $rcode"}
			}
			for {} {$querycount>0} {incr querycount -1} {
				::wyrm::setp {name o} [::wyrm::uriassist scanname $response $o]
				binary scan $response @${o}SS type class; incr o 4
			}
			for {} {$answercount>0} {incr answercount -1} {
				::wyrm::setp {name o} [::wyrm::uriassist scanname $response $o]
				binary scan $response @${o}SSIS type class ttl m; incr o 10
				switch $type {
					3 - 4 - 5 - 7 - 8 - 9 - 2 - 12 {
						lappend answer [lindex [::wyrm::uriassist scanname $response $o] 0]
					}
					13 {
						set o1 $o
						binary scan $response @${o1}c n; set n [expr {$n&0xFF}]; incr o1
						binary scan $response @${o1}a${n} cpu; incr o1 $n
						binary scan $response @${o1}c n; set n [expr {$n&0xFF}]; incr o1
						binary scan $response @${o1}a${n} os
						lappend answer $cpu $os
					}
					14 {
						::wyrm::setp {rmailbox o1} [::wyrm::uriassist scanname $response $o]
						::wyrm::setp {emailbox o1} [::wyrm::uriassist scanname $response $o1]
						lappend answer rmbx $rmailbox embx $emailbox
					}
					15 {
						binary scan $response @${o}S preference
						set exchange [lindex [::wyrm::uriassist scanname $response [expr {$o+2}]] 0]
						lappend answer $preference $exchange
					}
					6 {
						::wyrm::setp {mname o1} [::wyrm::uriassist scanname $response $o]
						::wyrm::setp {rname o1} [::wyrm::uriassist scanname $response $o1]
						regsub {[.]} $rname @ rname
						binary scan $response @${o1}IIII serial refresh retry expire
						lappend answer $mname $rname $serial $refresh $retry $expire
					}
					16 {
						set o1 $o
						binary scan $response @${o1}c n; set n [expr {$n&0xFF}]; incr o1
						binary scan $response @${o1}a${n} rdata
						lappend answer $rdata
					}
					default {
						set rdata ""; set dot ""
						for {set o1 $o; set m1 $m} {$m1>0} {incr m1 -1; incr o1} {
							binary scan $response @${o1}c xx
							set xx [expr {$xx & 0xFF}]
							append rdata $dot$xx; set dot .
						}
						lappend answer $rdata
					}
				}
				incr o $m
			}
			break
		}
	}
	if {[llength $answer]} {
		return $answer
	} else {
		error "unresolved name: [::wyrm::uri part $uri host]"
	}
}

		

oav put $urispace uri.nntp.+parts {scheme user password host port group first last article parameter}
oav put $urispace uri.nntp.+pattern [
		scheme nntp
	][
		opt //[opt [user-password]@][host-port]/
	](?:[
		newsgroup-article-range
	]|[
		article-name
	])[
		parameter][end
	]
oav put $urispace uri.nntp.+generate {s:(//(s(:s)@)s(:s)/)(s(/s(-s)))ap}
oav put $urispace uri.nntp.+defaultport 119
oav delegate $urispace uri.news uri.nntp
oav put $urispace uri.news.+parts {scheme user password host port group first last article parameter}
oav put $urispace uri.news.+pattern [
		scheme news
	][
		opt //[opt [user-password]@][host-port]/
	](?:[
		newsgroup-article-range
	]|[
		article-name
	])[
		parameter][end
	]
oav put $urispace uri.news.+generate {s:(//(s(:s)@)s(:s)/)(s(/s(-s)))ap}
oav put $urispace uri.news.+defaultport 119
oav delegate $urispace uri.snews uri.nntp
oav put $urispace uri.snews.+parts {scheme user password host port group first last article parameter}
oav put $urispace uri.snews.+pattern [
		scheme snews
	][
		opt //[opt [user-password]@][host-port]/
	](?:[
		newsgroup-article-range
	]|[
		article-name
	])[
		parameter][end
	]
oav put $urispace uri.snews.+generate {s:(//(s(:s)@)s(:s)/)(s(/s(-s)))ap}
oav put $urispace uri.snews.+defaultport 563

<nntp: Get method>
<nntp: Put method>
<nntp: Status method>
<nntp: Children method>

		

*-1 480* {
	set ostate $state
	::wyrm::uriassist puts $channel "AUTHINFO USER $user"
	set state PASS
}
PASS 3* {
	::wyrm::uriassist puts $channel "AUTHINFO PASS $user"
	set state [string toupper $ostate]
}
PASS 2* {
	::wyrm::uriassist puts $channel $command
	set state $ostate
}

		

oav method $urispace uri.nntp.get {uri args} {
	set async ""; set loop ""; set log 0
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -loop - -log {set [string range $p 1 end] $v}
			default {error "unknown put option: $p"}
		}
	}
	set user ""; set password ""; set host ""; set port [::wyrm::uri +defaultport $uri]
	set group ""; set first ""; set article ""
	foreach {p x} [::wyrm::uri part $uri] {set $p $x}
	if {[catch {
		if {[string length $group$first$article]==0} {
			error {no article specified in uri}
		}
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async {} $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	if {[string length $article]} {
		set state ARTICLE<>-1
		set command "ARTICLE <$article>"
	} else {
		set state GROUP-1
		set command "GROUP $group"
	}
	return [
		::wyrm::uriassist protocol $channel \
					state $state channel $channel user $user pass $password \
					group $group first $first article $article ostate "" \
					async $async logging $log command $command output "" \
		{
			<nntp Authorisation>
			GROUP-* 2* {
				::wyrm::uriassist puts $channel $command
				set state [string tolower $state]
			}
			group-* 2* {
				::wyrm::uriassist puts $channel "ARTICLE $first"
				set state START
			}
			START 2* {
				set state READ
			}
			ARTICLE<>-* 2* {
				::wyrm::uriassist puts $channel "ARTICLE <$article>"
				set state [string tolower $state]
			}
			article<>-* 2* {
				set state READ
			}
			READ . {
				set output [join $output \n]
				::wyrm::uriassist puts $channel "QUIT"
				set state quit
			}
			READ .* {
				lappend output [string range $line 1 end]
				set state READ
			}
			READ * {
				lappend output $line
				set state READ
			}
			<Terminate Telnet session>
		}
	]
}

		

oav method $urispace uri.nntp.put {uri data args} {
	set async ""; set loop ""; set log 0
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -loop - -log {set [string range $p 1 end] $v}
			default {error "unknown put option: $p"}
		}
	}
	set user ""; set password ""; set host ""; set port [::wyrm::uri +defaultport $uri]
	set group ""; set first ""; set article ""
	foreach {p x} [::wyrm::uri part $uri] {set $p $x}
	if {[catch {
		if {[string length $group$first$article]!=0} {
			error {article specified in uri}
		}
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	::wyrm::uriassist protocol $channel \
				state POST-1 channel $channel user $user pass $password data $data \
				async $async logging $log ostate "" command POST \
	{
			<nntp Authorisation>
		POST-* 2* {
			::wyrm::uriassist puts $channel "POST"
			set state [string tolower $state]
		}
		post-* 3* {
			set data [string trim [string map {\n. \n..} \n$data\n]]\n.
			::wyrm::uriassist puts $channel $data
			set state QUIT
		}
		QUIT 2* {
			::wyrm::uriassist puts $channel QUIT
			set state quit
		}
		<Terminate Telnet session>
	}
}

		

oav method $urispace uri.nntp.status {uri args} {
	set async ""; set loop ""; set log 0; set status {}
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -loop - -log {set [string range $p 1 end] $v}
			default {vassoc put status $p $v}
		}
	}
	set user ""; set password ""; set host ""; set port [::wyrm::uri +defaultport $uri]
	set group ""; set first ""; set article ""
	foreach {p x} [::wyrm::uri part $uri] {set $p $x}
	if {[catch {
		if {[string length $first$article]==0} {
			error {no article specified in uri}
		}
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async {} $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	if {[string length $article]} {
		set state HEAD<>-1
		set command "HEAD <$article>"
	} else {
		set state GROUP-1
		set command "GROUP $group"
	}
	return [
		::wyrm::uriassist protocol $channel \
					state $state channel $channel user $user pass $password \
					group $group first $first article $article ostate "" \
					async $async logging $log command $command uri $uri output $status \
		{
			<nntp Authorisation>
			GROUP-* 2* {
				::wyrm::uriassist puts $channel $command
				set state [string tolower $state]
			}
			group-* 2* {
				::wyrm::uriassist puts $channel "HEAD $first"
				set state START
			}
			group-* 4* {
				::wyrm::vassoc put output uri $uri
				::wyrm::vassoc put output exists 0
				::wyrm::uriassist puts $channel "QUIT"
				set state quit
			}
			START 2* {
				set state READ
			}
			HEAD<>-* 2* {
				::wyrm::uriassist puts $channel $command
				set state [string tolower $state]
			}
			head<>-* 2* {
				set state READ
			}
			head<>-* 4* {
				::wyrm::vassoc put output uri $uri
				::wyrm::vassoc put output exists 0
				::wyrm::uriassist puts $channel "QUIT"
				set state quit
			}
			READ . {
				::wyrm::vassoc put output uri $uri
				::wyrm::vassoc put output exists 1
				::wyrm::uriassist puts $channel "QUIT"
				set state quit
			}
			READ .* {
				if {[regexp {^[.]([^:]+):(.*)$} $line - p v]} {
					::wyrm::vassoc put output [string trim $p] [string trim $v]
				}
				set state READ
			}
			READ * {
				if {[regexp {^([^:]+):(.*)$} $line - p v]} {
					::wyrm::vassoc put output [string trim $p] [string trim $v]
				}
				set state READ
			}
			<Terminate Telnet session>
		}
	]
}

		

oav method $urispace uri.nntp.children {uri args} {
	set async ""; set loop ""; set log 0
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -loop - -log {set [string range $p 1 end] $v}
			default {error "unknown put option: $p"}
		}
	}
	set user ""; set password ""; set host ""; set port [::wyrm::uri +defaultport $uri]
	set group ""; set first ""; set article ""
	foreach {p x} [::wyrm::uri part $uri] {set $p $x}
	if {[string length $article$first]} {
		if {[string length $async]} {
			lappend async {}
			after idle $async
		} else {
			return {}
		}
	}
	if {[catch {uri part $uri ";after"} after]} {
		set after ""
	} else {
		set after [clock format $after -format "%y%m%d %H%M%S GMT" -gmt 1]
	}
	if {[catch {
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async {} $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	if {[string length $group]} {
		if {[string length $after]} {
			set state NEWNEWS-1
			set command "NEWNEWS $group $after"
		} else {
			set state GROUP-1
			set command "GROUP $group"
		}
	} else {
		if {[string length $after]} {
			set state NEWGROUPS-1
			set command "NEWGROUPS $after"
		} else {
			set state LIST-1
			set command "LIST"
		}
	}
	return [
		::wyrm::uriassist protocol $channel \
					state $state channel $channel user $user pass $password \
					group $group first $first article $article ostate "" a 1 l 0 \
					uri [::wyrm::uri remove $uri group first last article parameter] \
					async $async logging $log command $command output "" \
		{
			<nntp Authorisation>
			GROUP-* 2* {
				::wyrm::uriassist puts $channel $command
				set state [string tolower $state]
			}
			group-* 211* {
				if {[regexp {^211 \d+ (\d+) (\d+)} $line - a l]} {
					if {$a>$l} {
						::wyrm::uriassist puts $channel QUIT
						set state quit
					} else {
						::wyrm::uriassist puts $channel "STAT $a"
						incr a
						set state STAT
					}
				} else {
					close $channel
					error "GROUP badly formatted response: $line"
				}
			}
			STAT 2* {
				if {[regexp {^2\d\d \d+ <([^>]+)>} $line - article]} {
					lappend output [::wyrm::uri part $uri article $article]
					if {$a>$l} {
						::wyrm::uriassist puts $channel QUIT
						set state quit
					} else {
						::wyrm::uriassist puts $channel "STAT $a"
						incr a
						set state STAT
					}
				} else {
					close $channel
					error "STAT badly formatted response: $line"
				}
			}
			STAT 4* {
				if {$a>$l} {
					::wyrm::uriassist puts $channel QUIT
					set state quit
				} else {
					::wyrm::uriassist puts $channel "STAT $a"
					incr a
					set state STAT
				}
			}
			NEWNEWS-* 2* {
				::wyrm::uriassist puts $channel $command
				set state [string tolower $state]
			}
			newnews-* 2* {
				set state articles
			}
			articles . {
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			articles <*> {
				lappend output [::wyrm::uri part $uri article [string trim $line <>]]
				set state articles
			}
			LIST-* 2* {
				::wyrm::uriassist puts $channel $command
				set state [string tolower $state]
			}
			list-* 2* {
				set state groups
			}
			groups . {
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			groups * {
				lappend output [::wyrm::uri part $uri group [lindex $line] 0]
				set state groups
			}
			NEWGROUPS-* 2* {
				::wyrm::uriassist puts $channel $command
				set state [string tolower $state]
			}
			newgroups-* 2* {
				set state groups
			}
			<Terminate Telnet session>
		}
	]
}

		

oav put $urispace uri.pop.+parts {scheme user auth password host port message parameter}
oav put $urispace uri.pop.+pattern [scheme pop]//[user ":;"][AUTH][password]@[host-port][message][parameter][end]
oav put $urispace uri.pop.+generate {s://(s(;AUTH=s)(:s)@)s(:s)(/s)p}

<pop: Get method>
<pop: Delete method>
<pop: Status method>
<pop: Children method>

		

authorisation +* {
	switch -glob -- $auth {
		+APOP {
			if {[regexp {(<[^>]+>)} $line - timestamp]} {
				package require ramdv
				::wyrm::uriassist puts $channel "APOP $user [::wyrm::rsamdv $timestamp$pass]"
				set state transaction
			} else {
				error "missing timestamp for APOP: $line"
			}
		}
		"" - {[*]} {
			::wyrm::uriassist puts $channel "USER $user"
			set state PASS
		}
		+* {
			error "unknown authentication scheme: $auth"
		}
		* {
			error "SASL authentication not supported: $auth"
		}
	}
}
PASS +* {
	::wyrm::uriassist puts $channel "PASS $pass"
	set state transaction
}

		

quit * {
	;
}
!quit EOF {
	close $channel
	set state !QUIT!
}
!* ERR* {
	close $channel
	error "I/O $line"
}
!* EOF {
	close $channel
	error {unexpected end of session}
}
* -* {
	close $channel
	error [string range $line 1 end]
}
* * {
	close $channel
	error "unexpected pop response: $line"
}

		

oav method $urispace uri.pop.get {uri args} {
	set async ""; set loop ""; set log 0
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -loop - -log {set [string range $p 1 end] $v}
			default {error "unknown put option: $p"}
		}
	}
	set user ""; set auth ""; set password ""; set host ""; set port 110; set message ""
	foreach {p x} [::wyrm::uri part $uri] {set $p $x}
	if {[catch {
		if {[string length $message]==0} {
			error {no message specified in uri}
		}
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async {} $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	return [
		::wyrm::uriassist protocol $channel \
					state authorisation channel $channel \
					user $user auth $auth pass $password message $message \
					async $async logging $log output "" \
		{
			<pop3 Authorisation>
			transaction +* {
				::wyrm::uriassist puts $channel "RETR $message"
				set state start
			}
			start +* {
				set state read
			}
			read . {
				set output [join $output \n]
				::wyrm::uriassist puts $channel "QUIT"
				set state quit
			}
			read .* {
				lappend output [string range $line 1 end]
				set state read
			}
			read * {
				lappend output $line
				set state read
			}
			<Terminate POP3 Telnet session>
		}
	]
}

		

oav method $urispace uri.pop.delete {uri args} {
	set async ""; set loop ""; set log 0
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -loop - -log {set [string range $p 1 end] $v}
			default {error "unknown put option: $p"}
		}
	}
	set user ""; set auth ""; set password ""; set host ""; set port 110; set message ""
	foreach {p x} [::wyrm::uri part $uri] {set $p $x}
	if {[catch {
		if {[string length $message]==0} {
			error {no message specified in uri}
		}
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	::wyrm::uriassist protocol $channel \
					state authorisation channel $channel \
					user $user auth $auth pass $password message $message \
					async $async logging $log \
	{
		<pop3 Authorisation>
		transaction +* {
			::wyrm::uriassist puts $channel "DELE $message"
			set state QUIT
		}
		QUIT +* {
			::wyrm::uriassist puts $channel QUIT
			set state quit
		}
		<Terminate POP3 Telnet session>
	}
	return ""
}

		

oav method $urispace uri.pop.status {uri args} {
	set async ""; set loop ""; set log 0; set status {}
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -loop - -log {set [string range $p 1 end] $v}
			default {vassoc put status $p $v}
		}
	}
	set user ""; set auth ""; set password ""; set host ""; set port 110; set message ""
	foreach {p x} [::wyrm::uri part $uri] {set $p $x}
	if {[catch {
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async {} $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	return [
		::wyrm::uriassist protocol $channel \
					state authorisation channel $channel \
					user $user auth $auth pass $password message $message \
					async $async logging $log output $status uri $uri \
		{
			<pop3 Authorisation>
			transaction +* {
				if {[string length $message]} {
					::wyrm::uriassist puts $channel "UIDL $message"
					set state TOP
				} else {
					::wyrm::uriassist puts $channel STAT
					set state stat
				}
			}
			stat +* {
				::wyrm::vassoc put output number-message [lindex $line 1]
				::wyrm::vassoc put output number-bytes [lindex $line 2]
				::wyrm::vassoc put output uri $uri
				::wyrm::vassoc put output exists 1
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			stat -* {
				::wyrm::vassoc put output uri $uri
				::wyrm::vassoc put output exists 0
				::wyrm::uriassist parameter $output
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			TOP +* {
				::wyrm::vassoc put output uidl [lindex $line 2]
				::wyrm::uriassist puts $channel "TOP $message 0"
				set state top
			}
			TOP -* {
				::wyrm::uriassist puts $channel "TOP $message 0"
				set state top
			}
			top +* {
				set state read
			}
			top -* {
				::wyrm::vassoc put output uri $uri
				::wyrm::vassoc put output exists 0
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			read . {
				::wyrm::uriassist puts $channel "QUIT"
				set state quit
			}
			read .* {
				;
			}
			read * {
				if {[regexp {^([^:]+):(.*)$} $line - p v]} {
					::wyrm::vassoc put output [string trim $p] [string trim $v]
				}
				set state read
			}
			<Terminate POP3 Telnet session>
		}
	]
}

		

oav method $urispace uri.pop.children {uri args} {
	set async ""; set loop ""; set log 0
	set passwordparam ""; set scriptparam ""
	foreach {p v} $args {
		switch -- $p {
			-password {set passwordparam $v}
			-script {set scriptparam $v}
			-async - -loop - -log {set [string range $p 1 end] $v}
			default {error "unknown put option: $p"}
		}
	}
	set user ""; set auth ""; set password ""; set host ""; set port 110; set message ""
	foreach {p x} [::wyrm::uri part $uri] {set $p $x}
	if {[string length $message]} {
		if {[string length $async]} {
			lappend async {}
			after idle $async
		} else {
			return {}
		}
	}
	if {[catch {
		if {$log} {puts stderr "CONNECT $host $port"}
		set channel [socket $host $port]
		fconfigure $channel -translation {crlf crlf} -buffering line
		if {[string length $passwordparam]} {
			set password $passwordparam
		}
		if {[string length $scriptparam]} {
			set password [uplevel 1 $scriptparam]
		}
	} rs]} {
		catch {close $channel}
		if {[string length $async]} {
			lappend async {} $rs
			after idle $async
		} else {
			error $rs $::errorInfo $::errorCode
		}
	}
	return [
		::wyrm::uriassist protocol $channel \
					state authorisation channel $channel \
					user $user auth $auth pass $password\
					async $async logging $log output "" \
					uri [::wyrm::uri remove $uri message] \
		{
			<pop3 Authorisation>
			transaction +* {
				::wyrm::uriassist puts $channel "STAT"
				set state stat
			}
			stat +* {
				for {set i 1} {$i<=[lindex $line 1]} {incr i} {
					lappend output [::wyrm::uri part $uri message $i]
				}
				::wyrm::uriassist puts $channel QUIT
				set state quit
			}
			<Terminate POP3 Telnet session>
		}
	]
}