scp@SFI.SANTAFE.EDU ("Stephen C. Pope") (02/24/89)
After finding a few problems with Bret's Interactive Connection
Server, I thought I'd make the fixes available. One bug was
was the server not recognizing connections from the local host
on machines which return an unqualified host name from localhostname,
but a fully qualified hostname from getsocketpeername. The
fix is copied directly from the original server in init.ps.
The Times-Roman font scaled up to 20 looked a little
funny to me (no flames please, to each his own...), so the
fonts were altered, and the canvas made a little longer so
it doesn't chop off any but the longest host names. Also,
"reg" was changed to "always". Finally, since failing to respond
locks up the server to other connection requests, the connection
request will time out, returning a "no", after 30 seconds.
As the original init.ps loads user.ps before starting
up the server, the following code can be placed entirely
within user.ps, and the server rebooted (exit and restart)
without having to shut down the old server. I've not checked
to see if "/new start_new_server" is compatible with these mods.
Stephen C. Pope
Santa Fe Institute
scp@santafe.edu
% This is the code to define the new connection server into
% the systemdict.
%
% New variables added into system dict:
% /SecurityCanvas --- dict containing all the information about the
% popup window.
% /SecurityPopup --- The routine which popus up the window and waits
% for a responce.
% /LastConnectingHost --- The name of the last host to have connected
% into the server.
%
/define_new_server {
systemdict
begin
gsave
/SecurityCans 7 dict dup
begin
/Times-Bold findfont 16 scalefont setfont
/root framebuffer 230 75 createcanvas def
/ptr /ptr_m root setstandardcursor
root
begin
/Transparent false def
/EventsConsumed /AllEvents def
/Retained true def
end
root setcanvas
1 1 1 rgbcolor fillcanvas 0 0 0 rgbcolor strokecanvas
/no root 66 37 createcanvas dup
begin
/Transparent false def
/EventsConsumed /AllEvents def
/Mapped true def
/Retained true def
end
def
no setcanvas
0 0 0 rgbcolor dup setcolor strokecanvas
20 14 moveto (NO) show
/yes root 66 35 createcanvas dup
begin
/Transparent false def
/EventsConsumed /AllEvents def
/Mapped true def
/Retained true def
end
def
yes setcanvas 65 0 movecanvas
0 0 0 rgbcolor dup setcolor strokecanvas
18 12 moveto (YES) show
/always root 96 35 createcanvas dup
begin
/Transparent false def
/EventsConsumed /AllEvents def
/Mapped true def
/Retained true def
end
def
always setcanvas 132 0 movecanvas
0 0 0 rgbcolor dup setcolor strokecanvas
13 12 moveto (ALWAYS) show
/SecBoldFont /Times-Bold findfont 14 scalefont def
/SecFont /Times-Roman findfont 12 scalefont def
/SecurityAddInterests {
createevent dup
begin
/Name LeftMouseButton def
/Action UpTransition def
/Canvas yes def
end
expressinterest
createevent dup
begin
/Name ascii_keymap def
/Action DownTransition def
/Canvas yes def
end
expressinterest
createevent dup
begin
/Name /AddFocusClient def
/Action [ currentprocess yes] def
end
sendevent
createevent dup
begin
/Name LeftMouseButton def
/Action UpTransition def
/Canvas no def
end
expressinterest
createevent dup
begin
/Name LeftMouseButton def
/Action UpTransition def
/Canvas always def
end
expressinterest
createevent dup
begin
/Name /SecurityLift def
end
expressinterest
createevent dup
begin
/Name /Timeout def
/Canvas no def
end
expressinterest
} def
end
def
grestore
/SecurityPopup { % (host hame) => true/false(should we allow connection)
SecurityCans
begin
gsave
currentcursorlocation 18 sub exch 99 sub exch
root setcanvas
movecanvas
1 1 1 rgbcolor fillcanvas
0 0 0 rgbcolor dup setcolor
strokecanvas
10 46 moveto
SecBoldFont setfont
(Connecting Host: ) show
SecFont setfont
dup show
root /Mapped true put
createevent dup
begin
/Name /SecurityLift def
/TimeStamp currenttime .03 add def
end
sendevent
createevent dup
begin
/Name /Timeout def
/TimeStamp currenttime .5 add def
/Canvas no def
end
sendevent
{
root canvastotop
awaitevent /Canvas get
[
yes {
pop true exit
}
no {
pop false exit
}
always {
% always canvas
systemdict /RemoteHostRegistry get
exch cvn 1 put
% systemdict /NetSecurityWanted false put
true
exit
}
/Default {
createevent dup
begin
/Name /SecurityLift def
/TimeStamp currenttime .03 add def
end
sendevent
}
] case
} loop
root /Mapped false put
grestore
end
} def
/NetSecurityWanted true def
/server {
{
{
currentdict systemdict eq {
exit
} {
end
} ifelse
} loop
clear
newprocessgroup
SecurityCans
begin
SecurityAddInterests
end
{
NeWS_socket (r) file
} stopped
{
clear (%socketl2000) (r) file
} if
dup getsocketlocaladdress (NEWSSERVER) exch putenv
(TERM) (PostScript) putenv
{
dup mark exch acceptconnection
dup getsocketpeername /LastConnectingHost exch def
RemoteHostRegistry LastConnectingHost known
LastConnectingHost localhostname anchorsearch
{
pop (.) anchorsearch
{
pop pop RemoteHostRegistry localhostname known
} {
pop false
} ifelse
} {
pop false
} ifelse or
NetSecurityWanted not or {
true
} {
LastConnectingHost SecurityPopup
} ifelse
{
LastConnectingHost {
200 dict
begin
initmatrix newprocessgroup
/OriginatingHost exch def
exch pop exch pop cvx exec
currentprocess killprocessgroup
} fork
} {
closefile
} ifelse
cleartomark
} loop
} fork pop
} def
end
} def
%
% End of new server code...
%
define_new_server