├── .gitmodules ├── 9p4.f ├── README.md ├── srv └── testclient.f /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "mf"] 2 | path = mf 3 | url = https://github.com/iru-/mf 4 | -------------------------------------------------------------------------------- /9p4.f: -------------------------------------------------------------------------------- 1 | : c!+ ( c a -> a+1 ) swap over c! 1+ ; 2 | 3 | ( Format conversion ) 4 | : le1@ ( a -> n ) c@ ; 5 | : le2@ ( a -> n ) c@+ swap c@ 8 lshift or ; 6 | 7 | : le4@ ( a -> n ) 8 | c@+ swap 9 | c@+ 8 lshift swap 10 | c@+ 16 lshift swap 11 | c@ 24 lshift 12 | or or or ; 13 | 14 | : le8@ ( a -> n ) 15 | c@+ swap 16 | c@+ 8 lshift swap 17 | c@+ 16 lshift swap 18 | c@+ 24 lshift swap 19 | c@+ 32 lshift swap 20 | c@+ 40 lshift swap 21 | c@+ 48 lshift swap 22 | c@ 56 lshift 23 | or or or or or or or ; 24 | 25 | : 9p-s@ ( a -> a u ) dup 2 + swap le2@ ; 26 | 27 | : le1! ( n a -> ) c! ; 28 | 29 | : le2! ( n a -> ) 30 | over swap c!+ 31 | swap 8 rshift 32 | swap c! ; 33 | 34 | : le4! ( n a -> ) 35 | over >r c!+ 36 | r@ 08 rshift swap c!+ 37 | r@ 16 rshift swap c!+ 38 | r> 24 rshift swap c! ; 39 | 40 | : le8! ( n a -> ) 41 | over >r c!+ 42 | r@ 08 rshift swap c!+ 43 | r@ 16 rshift swap c!+ 44 | r@ 24 rshift swap c!+ 45 | r@ 32 rshift swap c!+ 46 | r@ 40 rshift swap c!+ 47 | r@ 48 rshift swap c!+ 48 | r> 56 rshift swap c! ; 49 | 50 | : 9p-s! ( src u dst -> ) 2dup le2! 2 + swap move ; 51 | : 9p-s, ( src u dst -> ) over 2 + allot 9p-s! ; 52 | 53 | ( Transmission/reception buffers ) 54 | 8192 constant /buf 55 | 56 | create txbuf /buf allot 57 | create tx# 0 , 58 | 59 | : txcur ( -> a ) txbuf tx# @ + ; 60 | : tx+ ( n -> ) tx# +! ; 61 | 62 | : tx1! ( n -> ) txcur le1! 1 tx+ ; 63 | : tx2! ( n -> ) txcur le2! 2 tx+ ; 64 | : tx4! ( n -> ) txcur le4! 4 tx+ ; 65 | : tx8! ( n -> ) txcur le8! 8 tx+ ; 66 | 67 | : txs! ( a u -> ) dup >r txcur 9p-s! r> 2 + tx+ ; 68 | : >tx ( a u -> ) tuck >r txcur r> move tx+ ; 69 | 70 | 71 | create rxbuf /buf allot 72 | create rx# 0 , 73 | 74 | : rxcur ( -> a ) rxbuf rx# @ + ; 75 | : rx+ ( n -> ) rx# +! ; 76 | 77 | : rx1@ ( -> n ) rxcur le1@ 1 rx+ ; 78 | : rx2@ ( -> n ) rxcur le2@ 2 rx+ ; 79 | : rx4@ ( -> n ) rxcur le4@ 4 rx+ ; 80 | : rx8@ ( -> n ) rxcur le8@ 8 rx+ ; 81 | 82 | : rxs@ ( -> a u ) rxcur 9p-s@ dup 2 + rx+ ; 83 | 84 | : 9p-rxbuf ( -> a u ) rxbuf /buf ; 85 | 86 | 87 | ( 9P utilities ) 88 | create curtag 0 , 89 | : tag ( -> n ) 90 | curtag @ 91 | dup 1 + 65535 mod 92 | curtag ! ; 93 | 94 | 4294967295 constant NOFID 95 | create curfid 0 , 96 | : newfid ( -> n ) 97 | curfid @ 98 | dup 1 + NOFID mod 99 | curfid ! ; 100 | 101 | : tx[ ( type -> ) 4 tx# ! tx1! tag tx2! ; 102 | : ]tx ( -> a u ) tx# @ txbuf le4! txbuf tx# @ ; 103 | 104 | struct 105 | 1 1 field qid-type 106 | 1 4 field qid-version 107 | 1 8 field qid-path 108 | end-struct qid% 109 | qid% nip constant /qid 110 | 111 | struct 112 | 1 2 field stat-size 113 | 1 2 field stat-type 114 | 1 4 field stat-dev 115 | qid% field stat-qid 116 | 1 4 field stat-mode 117 | 1 4 field stat-atime 118 | 1 4 field stat-mtime 119 | 1 8 field stat-length 120 | end-struct stat-base% 121 | stat-base% nip constant /stat-base 122 | 123 | : stat-name ( a -> 'name ) /stat-base + ; 124 | : stat-uid ( a -> 'uid ) stat-name 9p-s@ + ; 125 | : stat-gid ( a -> 'gid ) stat-uid 9p-s@ + ; 126 | : stat-muid ( a -> 'muid ) stat-gid 9p-s@ + ; 127 | 128 | \ compute stat structure size without the size field itself 129 | : get-stat-size ( 'stat -> size ) 130 | dup stat-muid 9p-s@ + swap - 2 - ; 131 | 132 | : set-stat-size ( 'stat -> size ) 133 | dup get-stat-size dup >r 134 | swap stat-size le2! r> ; 135 | 136 | : stat>tx ( 'stat -> ) dup set-stat-size 2 + dup tx2! >tx ; 137 | 138 | 0 0 2constant stat-s-dont-touch 139 | -1 constant stat-dont-touch 140 | 141 | 142 | \ Addresses valid for every R-message 143 | : 9p-size@ ( a -> msg-size ) le4@ ; 144 | : 9p-type@ ( a -> msg-type ) 4 + le1@ ; 145 | : 9p-tag@ ( a -> msg-tag ) 5 + le2@ ; 146 | : 9p-body ( a -> 'msg-body ) 7 + ; 147 | 148 | \ Error on short reads or wrong response type 149 | : rxerror? ( msg-size type -> flag ) 150 | rxbuf 9p-type@ <> swap rxbuf 9p-size@ <> or ; 151 | 152 | ( 9P messages ) 153 | : Tversion ( -> a u ) 100 tx[ 8192 tx4! s" 9P2000" txs! ]tx ; 154 | 155 | : Rversion ( n -> a u msize ) 156 | 101 rxerror? if 0 0 0 exit then 157 | rxbuf 9p-body dup >r 158 | 4 + 9p-s@ 159 | r> le4@ ; 160 | 161 | : Tattach ( 'uname n1 'aname n2 -> rootfid a u ) 162 | 104 tx[ 163 | newfid dup >r tx4! 164 | NOFID tx4! 165 | >r >r txs! 166 | r> r> txs! 167 | r> 168 | ]tx ; 169 | 170 | : Rattach ( n -> 'qid ) 171 | 105 rxerror? if 0 exit then 172 | rxbuf 9p-body ; 173 | 174 | : Twalk ( 'name #name ... #names fid -> newfid a u ) 175 | 110 tx[ 176 | tx4! 177 | newfid dup >r tx4! 178 | dup tx2! 179 | dup if 180 | 1- for txs! next 181 | else 182 | drop 183 | then 184 | r> 185 | ]tx ; 186 | 187 | : clonefid ( fid -> newfid a u ) 0 swap Twalk ; 188 | 189 | : Rwalk ( n -> 'qids #qids ) 190 | 111 rxerror? if 0 -1 exit then 191 | rxbuf 9p-body dup 2 + swap le2@ ; 192 | 193 | : Topen ( fid mode -> a u ) 194 | 112 tx[ 195 | swap tx4! tx1! 196 | ]tx ; 197 | 198 | : Tcreate ( fid 'name #name perm mode -> a u ) 199 | 114 tx[ 200 | >r >r 2>r 201 | tx4! 2r> txs! r> tx4! r> tx1! 202 | ]tx ; 203 | 204 | : Ropencreate ( n type -> 'qid iounit ) 205 | rxerror? if 0 0 exit then 206 | rxbuf 9p-body dup /qid + le4@ ; 207 | 208 | : Ropen ( n -> 'qid iounit ) 113 Ropencreate ; 209 | : Rcreate ( n -> 'qid iounit ) 115 Ropencreate ; 210 | 211 | : rw ( fid offset count -> ) 212 | >r >r tx4! r> tx8! r> tx4! ; 213 | 214 | : Tread ( fid offset count -> a u ) 215 | 116 tx[ rw ]tx ; 216 | 217 | : Rread ( n -> data count ) 218 | 117 rxerror? if 0 0 exit then 219 | rxbuf 9p-body dup le4@ swap 4 + swap ; 220 | 221 | : Twrite ( fid offset data count -> a u ) 222 | tuck >r >r 223 | 118 tx[ 224 | rw 225 | r> r> >tx 226 | ]tx ; 227 | 228 | : Rwrite ( n -> count ) 229 | 119 rxerror? if 0 exit then 230 | rxbuf 9p-body le4@ ; 231 | 232 | 233 | : Rminimal ( n type -> ) rxerror? if exit then ; 234 | 235 | : Tclunkremove ( fid type -> a u ) tx[ tx4! ]tx ; 236 | 237 | : Tclunk ( fid -> a u ) 120 Tclunkremove ; 238 | : Rclunk ( n -> ) 121 Rminimal ; 239 | 240 | : Tremove ( fid -> a u ) 122 Tclunkremove ; 241 | : Rremove ( fid -> a u ) 123 Rminimal ; 242 | 243 | : Tstat ( fid -> a u ) 124 tx[ tx4! ]tx ; 244 | 245 | : Rstat ( n -> 'stat len ) 246 | 125 rxerror? if 0 exit then 247 | rxbuf 9p-body dup 2 + swap le2@ ; 248 | 249 | : Twstat ( 'stat fid -> len ) 126 tx[ tx4! stat>tx ]tx ; 250 | : Rwstat ( n -> ) 127 Rminimal ; 251 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 9p4 2 | === 3 | 4 | 9p4 is an implementation of the 9P protocol in gforth [1]. It provides routines 5 | for encoding and decoding 9P [2] [3] messages, along with auxiliary routines for 6 | implementing 9P clients and servers. 7 | 8 | The remainder of this document assumes familiarity with 9P and its messages. 9 | 10 | 11 | ## Data structures 12 | 13 | The fields in a 9p4 data structure are named `prefix-field`, where `prefix` is 14 | the 9P data structure/concept name. 15 | 16 | #### Qid 17 | 18 | * `qid-type ( 'qid -> 'qid-type )` 19 | * `qid-version ( 'qid -> 'qid-version )` 20 | * `qid-path ( 'qid -> 'qid-path )` 21 | * `qid% ( -> qid-alignment #qid )`: for use with gforth struct allocation routines 22 | * `/qid ( -> #qid )`: size of `qid` structure 23 | 24 | 25 | #### Stat 26 | * `stat-size ( 'stat -> 'stat-size )` 27 | * `stat-type ( 'stat -> 'stat-type )` 28 | * `stat-dev ( 'stat -> 'stat-dev )` 29 | * `stat-qid ( 'stat -> 'stat-qid )` 30 | * `stat-mode ( 'stat -> 'stat-mode )` 31 | * `stat-atime ( 'stat -> 'stat-atime )` 32 | * `stat-mtime ( 'stat -> 'stat-mtime )` 33 | * `stat-length ( 'stat -> 'stat-length )` 34 | * `stat-name ( 'stat -> 'stat-name )` 35 | * `stat-uid ( 'stat -> 'stat-uid )` 36 | * `stat-gid ( 'stat -> 'stat-gid )` 37 | * `stat-muid ( 'stat -> 'stat-muid )` 38 | * `stat-base% ( -> stat-alignment #stat )`: size of the constant-sized part of 39 | `stat`; for use with gforth struct allocation routines 40 | * `/stat-base ( -> #stat )`: size of the constant-sized part of `stat` 41 | 42 | 43 | ## Encoding and decoding 44 | 45 | Routines encoding T- messages always return a buffer and length containing the 46 | encoded message on the top of stack, i.e. their stack diagram has the form 47 | `( ... -> ... buf #buf )`. On the other hand, all routines decoding R- messages 48 | expect the message length on the top of stack, i.e. `( #msg -> ... )`. 49 | 50 | A routine's name and stack diagram reflect its name and parameters as described 51 | in [2]. Whenever there are less items in the stack diagram than in the 52 | protocol documentation, 9p4 chooses sensible values for the missing parameters. 53 | 54 | 55 | * ```Tversion ( -> buf #buf )``` 56 | * ```Rversion ( #msg -> version #version msize )``` 57 | * ```Tattach ( uname #uname aname #aname -> rootfid buf #buf )``` 58 | * ```Rattach ( #msg -> 'qid )``` 59 | * ```Twalk ( name #name ... #names fid -> newfid buf #buf )``` 60 | * ```clonefid ( fid -> newfid buf #buf )```: same as ```0 fid Twalk``` 61 | * ```Rwalk ( #msg -> 'qids #qids )``` 62 | * ```Topen ( fid mode -> buf #buf )``` 63 | * ```Ropen ( #msg -> 'qid iounit )``` 64 | * ```Tcreate ( fid name #name perm mode -> buf #buf )``` 65 | * ```Rcreate ( #msg -> 'qid iounit )``` 66 | * ```Tread ( fid offset count -> buf #buf )``` 67 | * ```Rread ( #msg -> data count )``` 68 | * ```Twrite ( fid offset data count -> buf #buf )``` 69 | * ```Rwrite ( #msg -> count )``` 70 | * ```Tclunk ( fid -> buf #buf )``` 71 | * ```Rclunk ( #msg -> )``` 72 | * ```Tremove ( fid -> buf #buf )``` 73 | * ```Rremove ( fid -> buf #buf )``` 74 | * ```Tstat ( fid -> buf #buf )``` 75 | * ```Rstat ( #msg -> 'stat len )``` 76 | * ```Twstat ( 'stat fid -> len )``` 77 | * ```Rwstat ( #msg -> )``` 78 | 79 | 80 | ## References 81 | 82 | [1] [gforth](https://gforth.org) 83 | 84 | [2] [introduction to the Plan 9 File Protocol, 9P](https://man.9front.org/5/intro) 85 | 86 | [3] [A sane distributed file system](https://9p.cat-v.org) 87 | -------------------------------------------------------------------------------- /srv: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | 4 | if [ x"$1" = x"fifo" ]; then 5 | rm -f /tmp/cli-srv /tmp/srv-cli 6 | mkfifo /tmp/cli-srv; mkfifo /tmp/srv-cli 7 | echo fifo 8 | $HOME/Downloads/u9fs/u9fs -nz -a none -D /tmp/srv-cli 9 | else 10 | sudo $PLAN9/bin/listen1 'tcp!localhost!9999' $HOME/Downloads/u9fs/u9fs -nz -a none -D 11 | fi 12 | -------------------------------------------------------------------------------- /testclient.f: -------------------------------------------------------------------------------- 1 | require unix/socket.fs 2 | require 9p4.f 3 | 4 | warnings off 5 | 0 value mysock 6 | : connect ( a u port -> ) open-socket to mysock ; 7 | : write ( a u -> ) mysock write-socket ; 8 | : read ( -> n ) mysock 9p-rxbuf read-socket nip ; 9 | 10 | : ?abort ( flag a u -> ) 11 | >r >r if 12 | ." error: " r> r> type abort 13 | then 14 | r> drop r> drop ; 15 | 16 | : .qfield ( n -> ) s>d <# #s #> type ; 17 | : .qtype ( a -> ) qid-type le1@ .qfield ; 18 | : .qversion ( a -> ) qid-version le4@ decimal .qfield ; 19 | : .qpath ( a -> ) qid-path le8@ hex .qfield ; 20 | : .qid ( a -> ) 21 | base @ >r 22 | ." (" dup .qpath space dup .qversion space .qtype ." )" 23 | r> base ! ; 24 | 25 | : .qids ( a u -> ) 26 | 1- for 27 | dup .qid space /qid + 28 | next 29 | drop ; 30 | 31 | : .mode ( u -> ) base @ >r 8 base ! . r> base ! ; 32 | 33 | : .stat ( 'stat len -> ) 34 | drop 35 | ." size : " dup stat-size le2@ . cr 36 | ." type : " dup stat-type le2@ . cr 37 | ." dev : " dup stat-dev le4@ . cr 38 | ." qid : " dup stat-qid .qid cr 39 | ." mode : " dup stat-mode le4@ .mode cr 40 | ." atime : " dup stat-atime le4@ . cr 41 | ." mtime : " dup stat-mtime le4@ . cr 42 | ." length: " dup stat-length le8@ . cr 43 | ." name : " dup stat-name 9p-s@ type cr 44 | ." uid : " dup stat-uid 9p-s@ type cr 45 | ." gid : " dup stat-gid 9p-s@ type cr 46 | ." muid : " stat-muid 9p-s@ type cr ; 47 | 48 | 49 | s" 127.0.0.1" 9999 connect 50 | 51 | Tversion write 52 | read Rversion 53 | ." connection msize: " . cr 54 | ." protocol version: " type cr 55 | 56 | cr 57 | -1 value rootfid 58 | s" iru" s" " Tattach write to rootfid read Rattach 59 | ." root fid: " rootfid . cr 60 | ." root qid: " .qid cr 61 | 62 | cr 63 | rootfid clonefid write 64 | ." root clone fid: " . cr read Rwalk 65 | ." #qids walked : " . cr drop \ drop pointer to array of qids 66 | 67 | cr 68 | -1 value rfid 69 | s" /etc/hosts" 1 rootfid Twalk write to rfid 70 | ." read fid : " rfid . cr read Rwalk 71 | ." #qids walked: " dup . cr 72 | ." qids : " .qids cr 73 | 74 | cr 75 | s" hosts" s" etc" 2 rootfid Twalk write 76 | ." final fid : " . cr read Rwalk 77 | ." #qids walked: " dup . cr 78 | ." qids : " .qids cr 79 | 80 | cr 81 | rfid 0 Topen write read Ropen 82 | ." opened: " rfid . cr 83 | ." iounit: " . cr 84 | ." qid : " .qid cr 85 | 86 | cr 87 | rfid 0 32 Tread write read Rread 88 | ." #read: " dup . cr 89 | ." --- " cr 90 | type cr 91 | ." --- " cr 92 | 93 | cr 94 | -1 value dirfid 95 | s" /tmp" 1 rootfid Twalk write to dirfid 96 | ." dir fid: " dirfid . cr read Rwalk -1 = s" can't walk to dir" ?abort drop 97 | 98 | dirfid s" aaa" 420 1 Tcreate write read Rcreate 99 | over 0 = s" can't create file" ?abort 100 | ." created!" cr 101 | ." iounit: " . cr 102 | ." qid : " .qid cr 103 | 104 | dirfid Tclunk write read Rclunk 105 | 106 | cr 107 | -1 value wfid 108 | s" /tmp/aaa" 1 rootfid Twalk write to wfid 109 | ." write fid: " wfid . cr read Rwalk -1 = s" can't walk to file" ?abort drop 110 | 111 | wfid 1 Topen write read Ropen drop drop 112 | wfid 0 s" written by 9p4" Twrite write read Rwrite 113 | ." #written : " . cr 114 | 115 | cr 116 | wfid Tstat write read Rstat over swap .stat 117 | constant wstat 118 | 119 | \ change name, mode and group of the file 120 | stat-dont-touch wstat stat-type le2! 121 | stat-dont-touch wstat stat-dev le4! 122 | 123 | stat-dont-touch wstat stat-qid qid-type le1! 124 | stat-dont-touch wstat stat-qid qid-version le4! 125 | stat-dont-touch wstat stat-qid qid-path le8! 126 | 127 | 421 wstat stat-mode le4! 128 | stat-dont-touch wstat stat-atime le4! 129 | stat-dont-touch wstat stat-mtime le4! 130 | stat-dont-touch wstat stat-length le8! 131 | 132 | s" abc" wstat stat-name 9p-s! 133 | stat-s-dont-touch wstat stat-uid 9p-s! 134 | s" wheel" wstat stat-gid 9p-s! 135 | stat-s-dont-touch wstat stat-muid 9p-s! 136 | 137 | wstat wfid Twstat write read Rwstat 138 | wfid Tstat write read Rstat cr .stat 139 | 140 | wfid Tremove write read Rremove 141 | rootfid Tclunk write 142 | bye 143 | --------------------------------------------------------------------------------