Commit 812fdb3a authored by bernd's avatar bernd

More work on terminal, ready to be tested

parent 1cd6cd8b
......@@ -57,4 +57,5 @@ s" krypto mem request too big" throwcode !!kr-size!!
s" secret storage size wrong" throwcode !!sec-size!!
s" host not found" throwcode !!host-notfound!!
s" too many revokes chained" throwcode !!maxlookup!!
s" file class denied" throwcode !!fileclass!!
\ No newline at end of file
s" file class denied" throwcode !!fileclass!!
s" no free termservers" throwcode !!no-termserver!!
\ No newline at end of file
......@@ -15,6 +15,8 @@
\ You should have received a copy of the GNU Affero General Public License
\ along with this program. If not, see <http://www.gnu.org/licenses/>.
Sema file-sema
Variable net2o-path
pad $400 get-dir net2o-path $!
......@@ -31,6 +33,7 @@ cmd-class class
field: term-h
field: fs-inbuf
field: fs-outbuf
field: fs-termtask
method fs-read
method fs-write
method fs-open
......@@ -109,10 +112,55 @@ end-class termclient-class
termclient-class class
end-class termserver-class
Variable termserver-tasks
User termfile
: ts-type ( addr u -- ) termfile @ .fs-outbuf $+! ;
: ts-emit ( c -- ) termfile @ .fs-outbuf c$+! ;
: ts-form ( -- w h ) termfile @ >o term-w @ term-h @ o> ;
: ts-key? ( -- flag ) termfile @ .fs-inbuf $@len 0<> ;
: ts-key ( -- key )
BEGIN ts-key? 0= WHILE stop REPEAT
termfile @ >o fs-inbuf $@ drop c@ fs-inbuf 0 1 $del o> ;
' ts-type ' ts-emit what's cr ' ts-form output: termserver-out
op-vector @
what's at-xy what's at-deltaxy what's page what's attr!
termserver-out
IS attr! IS page IS at-deltaxy IS at-xy
op-vector !
' ts-key ' ts-key? input: termserver-in
1 Constant file-permit#
2 Constant socket-permit#
4 Constant ts-permit#
8 Constant tc-permit#
file-permit# Value fs-class-permit \ by default permit only files
: >termserver-io ( -- )
[: up@ { w^ t } t cell termserver-tasks $+! ;] file-sema c-section
ts-permit# fs-class-permit or to fs-class-permit ;
event: ->termfile ( o -- ) dup termfile ! >o form term-w ! term-h ! o>
termserver-in termserver-out ;
event: ->termclose ( -- ) termfile off default-in default-out ;
:noname ( addr u -- u ) tuck fs-inbuf $+! ; termserver-class to fs-write
:noname ( addr u -- u ) fs-outbuf $@len umin >r
fs-outbuf $@ r@ umin rot swap move
fs-outbuf 0 r@ $del r> ; termserver-class to fs-read
:noname ( addr u 64n -- ) 64drop 2drop
[: termserver-tasks $@ 0= !!no-termserver!!
@ termserver-tasks 0 cell $del dup fs-termtask !
<event o elit, ->termfile event>
;] file-sema c-section
; termserver-class to fs-open
:noname ( -- )
[: fs-termtask @ ?dup-IF
<event ->termclose event>
fs-termtask cell termserver-tasks $+! fs-termtask off
THEN ;] file-sema c-section
; termserver-class to fs-close
Create file-classes
' fs-class ,
......@@ -122,8 +170,6 @@ Create file-classes
here file-classes - cell/ Constant file-classes#
$1 Value fs-class-permit \ by default permit only files
: fs-class! ( n -- )
dup file-classes# u>= !!fileclass!!
1 over lshift fs-class-permit and 0= !!fileclass!!
......@@ -189,8 +235,6 @@ $1 Value fs-class-permit \ by default permit only files
)
rot id>addr? .fs-write dup /back file( dup hex. residualwrite @ hex. cr ) ;
Sema file-sema
\ careful: must follow exactpy the same loic as slurp (see below)
: n2o:spit ( -- ) fstates 0= ?EXIT
[: +calc fstates 0 { states fails }
......
\ terminal 06aug2014py
\ Copyright (C) 2014 Bernd Paysan
\ This program is free software: you can redistribute it and/or modify
\ it under the terms of the GNU Affero General Public License as published by
\ the Free Software Foundation, either version 3 of the License, or
\ (at your option) any later version.
\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
\ GNU Affero General Public License for more details.
\ You should have received a copy of the GNU Affero General Public License
\ along with this program. If not, see <http://www.gnu.org/licenses/>.
: collect-keys ( -- )
BEGIN key? WHILE key key-buf$ c$+! REPEAT ;
get-current also net2o-base definitions
term-table >table
fs-table $@ inherit-table term-table
+net2o: at-xy ( x y -- ) F at-xy ;
+net2o: set-form ( w h -- ) term-h ! term-w ! ;
+net2o: get-form ( -- ) form swap lit, lit, set-form ;
gen-table $freeze
' context-table is gen-table
$35 net2o: terminal ( -- o:terminal ) \ push a terminal object
term-context @ dup 0= IF
drop n2o:new-term dup term-context !
THEN n:>o ;
term-table >table
previous set-current
0 [IF]
Local Variables:
forth-local-words:
(
(("net2o:" "+net2o:") definition-starter (font-lock-keyword-face . 1)
"[ \t\n]" t name (font-lock-function-name-face . 3))
("[a-z\-0-9]+(" immediate (font-lock-comment-face . 1)
")" nil comment (font-lock-comment-face . 1))
)
forth-local-indent-words:
(
(("net2o:" "+net2o:") (0 . 2) (0 . 2) non-immediate)
(("[:") (0 . 1) (0 . 1) immediate)
((";]") (-1 . 0) (0 . -1) immediate)
)
End:
[THEN]
\ No newline at end of file
\ test file for net2o terminal
require client-tests.fs \ test framework
require test-keys.fs \ we want the test keys - never use this in production!
+debug
%droprate
?nextarg [IF] s>number drop to net2o-port [THEN]
i'm test
strict-keys on \ terminal server wants strict keys
init-server
event-loop-task
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment