PS-HTTPD

web-server-1

PS-HTTPD es un servidor web muy simple escrito en… sí: PS, Postscript!

Aquí copio el código fuente para los curiosos…

%!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% @(#)ps.ps
% PostScript meta-interpreter.
% Copyright © 1989.
% By Don Hopkins. (don@brillig.umd.edu)
% All rights reserved.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  This program is provided for UNRESTRICTED use provided that this
%  copyright message is preserved on all copies and derivative works.
%  This is provided without any warranty. No author or distributor
%  accepts any responsibility whatsoever to any person or any entity
%  with respect to any loss or damage caused or alleged to be caused
%  directly or indirectly by this program. If you have read this far,
%  you obviously take this stuff far too seriously, and if you’re a
%  lawyer, you should give up your vile and evil ways, and go find
%  meaningful employment. So there.
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Problems: % How do we catch the execution of event Name and Action dict values, % executed by awaitevent?

systemdict begin

/iexec-types 100 dict def /iexec-operators 100 dict def /iexec-names 200 dict def /iexec-exit-stoppers 20 dict def /iexec-single-forall-types 20 dict def /iexec-array-like-types 20 dict def

/iexec-continue-procs? true def /iexec-continue-names? true def

/iexecing? false def

/signal-error { % name => - dbgbreak } def

/iexec-stopped-pending? { % - => bool false ExecSP 1 sub -1 0 { ExecStack exch get % ob dup type /dicttype eq { dup /continuation known { dup /continuation get /stopped eq { pop true exit } { pop } ifelse } { pop } ifelse } { pop } ifelse } for } def

/olddbgerrorhandler /DbgErrorHandler load ?def

/iexec-handle-error { iexec-stopped-pending? true { stoppedpending? } ifelse { /stop load PushExec } { $error /errorname get signal-error } ifelse } def

/DbgErrorHandler { iexecing? { iexec-handle-error } //olddbgerrorhandler ifelse } def

/isarray? { % obj => bool type iexec-array-like-types exch known } ?def

% % A procedure to allow programmer to know if there is a “stopped” % pending somewhere within the scope of the call. This is used % to check if it’s safe to rely on stopped to handle an error, % rather than the errordict. The debugger can use this to % catch errors that have no stopped call pending. % /stoppedpending? { % - => bool false currentprocess /ExecutionStack get % result a dup length 1 sub -2 1 { % result a i 2 copy get % result a i index exch 1 sub 2 index exch get % result a index proc dup isarray? { exch 1 sub get % result a caller /stopped load eq {pop true exch exit} if } { pop pop } ifelse } for pop } ?def

/?iexec-handle-error { % - => - { iexec-handle-error } if } def

% interpretivly execute an object

/iexec { % obj => … 100 dict begin % This functions “end”s the interpreter dict, executes an object in the % context of the interpreted process, and “begin”’s back onto the % interpreter dict. Note the circularity. /MumbleFrotz [ % obj => … /end load /exec load currentdict /begin load ] cvx def

/ExecStack 32 array def
/ExecSP -1 def

/PushExec [ % obj => -
  /ExecSP dup cvx 1 /add load /store load
  ExecStack /exch load /ExecSP cvx /exch load /put load
] cvx def

/PopExec [ % obj => -
  ExecStack /ExecSP cvx /get load
  /ExecSP dup cvx 1 /sub load /store load
] cvx def

/TraceStep {
  iexec-step
} def

PushExec

{ ExecSP 0 lt { nullproc exit } if % nothing left to execute? goodbye.

  ExecStack 0 ExecSP 1 add getinterval
  TraceStep pop

  % pop top of exec stack onto the operand stack
  PopExec

  % is it executable? (else just push literal)
  dup xcheck { % obj
% do we know how to execute it?
dup type
    //iexec-types 1 index known { % obj type
  //iexec-types exch get exec % ...
} { % obj type
  % some random type. just push it.
  pop % obj
} ifelse
  } if % else: obj

} loop % goodbye-proc

currentdict /MumbleFrotz undef % Clean up circular reference

end exec % whoever exited the above loop left a goodbye proc on the stack. } def

% visually execute an object, dumping drawing of stacks to trace-file

/vexec { % obj => … { { ( %! /l { % gray x y lastx lasty moveto 2 copy lineto 0 setgray stroke

2 copy .3 0 360 arc 0 setgray fill

.25 0 360 arc setgray fill

pause } def /e { % x y => - gsave translate 0 setlinewidth 360 32 div rotate 16 { 0 0 moveto 1 0 rlineto 0 setgray stroke 1 0 .1 0 360 arc random setgray fill 360 16 div rotate } repeat grestore } def systemdict /pause known not { /pause {} def } if gsave 20 20 scale 1 1 translate 0 setgray 0 setlinewidth erasepage ) trace-print /TraceX 0 def /TraceY count 1 sub def /TraceZ 0 def /TraceStep { % (() print ExecSP iexec-printexec ()print ) trace-print TraceY TraceX % x y /TraceX ExecSP def /TraceY count 2 sub def /TraceZ TraceZ 1 add 360 mod def TraceZ 15 mul cos 1 add 3 div 1 exch sub trace-print# TraceX trace-print# TraceY trace-print# trace-print# trace-print# % print x,y (l\n) trace-print random .2 le { flush pause pause pause } if } def /signal-error { % name => - /TraceX ExecSP def /TraceY count 3 sub def TraceX trace-print# TraceY trace-print# (e\n) trace-print (grestore showpage\n) trace-print trace-flush /stop load PushExec } def } meta-exec exec (grestore showpage\n) trace-print trace-flush } iexec } def

/trace-file (%socketc2000) (w) file def

/trace-flush { trace-file dup null eq { pop currentfile } if flushfile } def

/trace-print { % string => - trace-file dup null eq { pop currentfile } if exch writestring } def

%/trace-print# {typedprint} def %/trace-print# {=} def /trace-print# { (%\n) sprintf trace-print } def

/annealexec { % obj => … { { ( %! /F /Times-Roman findfont /s { % str point h s b x y moveto sethsbcolor F exch scalefont setfont show } def gsave ) trace-print /TracedObjects 2000 dict def /TracedTypes 20 dict def TracedTypes begin /nametype 0 def /array .2 def /packedarray .2 def /operatortype .4 def /dicttype .6 def /canvas .8 def end

  /!FieldWidth 100 def
  /!FieldHeight 100 def

  /!StartBrightness .5 def
  /!StartSaturation 1 def
  /!StartPoint 18 def

  /!StepBrightness .2 def
  /!StepSaturation .2 def

  /!DecayBrightness .95 def
  /!DecaySaturation .95 def

  /!TraceHistory 10 def

  /!DistNear 5 def
  /!DistFar 50 def
  /!DistGrav .1 def
  /!DecaySpeedNear .5 def

  /!MagDecay .9 def
  /!Friction .95 def

  /LastTraced [] def

  /TraceStep { % estack => popped
  dup length 1 sub get % obj
  dup type TracedTypes known {
    TracedObjects 1 index known not {
      30 dict begin
    TracedObjects 1 index currentdict put
    /Hue TracedTypes 2 index type get def
    /Saturation !StartSaturation def
    /Brightness !StartBrightness def
    /Point !StartPoint def
    /X !FieldWidth random mul def
    /Y !FieldHeight random mul def
    /DX 0 def
    /DY 0 def
    /String 1 index cvs def
      end
    } if
    10 dict begin
      /Other null def  /Dist 0 def  /Dir 0 def  /Mag 1 def
      TracedObjects exch get begin
    LastObjects {
      TracedObjects exch get
      dup currentdict eq { pop } {
        /Other exch store
        Other /X get X sub
        Other /Y get Y sub
        2 index dup mul 2 index dup mul sub sqrt
        /Dist exch store
        Dist !DistNear lt {
          % Wow, they're close together:
          % Let's slow the other one down!
          pop pop
          Other begin
        /DX DX !DecaySpeedNear mul def
        /DY DY !DecaySpeedNear mul def
          end
        } {
          atan /Dir exch store
          Dist DistFar min
          DistFar div DistGrav mul
          /DX 1 index Dir cos mul Mag mul DX add store
          /DY 1 index Dir sin mul Mag mul DY add store
        } ifelse
        /Brightness Brightness !StepBrightness add 1 min def
        /Mag Mag !DecayMag mul store
      } ifelse
    } forall
    /LastObjects [
      currentdict LastObjects {
            counttomark !TraceHistory ge { exit } if
      } forall
    ] store
      end
    end
    TracedObjects {
      begin
        /X X DX add !FieldWidth add !FieldWidth mod def
        /Y Y DY add !FieldHeight add !FieldHeight mod def
        /DX DX !Friction mul def
        /DY DY !Friction mul def
        /Brightness Brightness !DecayBrightness mul def
        Y X Brightness Saturation Hue Point Str
    ((%) % % % % % % F\n) sprintf trace-print
      end
    } forall
    null % for pop
  } ifelse
  } def
} meta-exec
exec
(grestore showpage\n) trace-print trace-flush

} iexec } def

/iexec-printexec { % index => - ExecStack 1 index get dup type /dicttype eq { dup /namestring known { begin namestring end } if } if exch (% %\n) printf } def

/iexec-where { 0 1 ExecSP { iexec-printexec } for } def

% execute step by step on the cyberspace deck stack display. % To step, execute ‘exit’. (make an ‘exit’ button to step with the mouse).

/cexec { { { /TraceStep { ExecSP iexec-printexec select-object /ThisStep ThisStep 1 add def ThisStep Steps ge { /ThisStep 0 def _SendUpdateStack eventloop } if null } def /Steps 1 def /ThisStep 0 def } meta-exec exec } iexec } def

/iexec-step { % operand stack … execee } def

/iexec-sends { % - => context0 context1 … contextn ExecSP 1 sub -1 0 { ExecStack exch get % ob dup type /dicttype eq { dup /continuation known { dup /continuation get /send eq { /context get dup null eq { pop } if } { pop } ifelse } { pop } ifelse } { pop } ifelse } for } def

% Re-enter the NeWS PS interpreter, execute object, and return. % We need to construct the currentprocess’s /SendStack from the interpreter’s % send stack, so ThisWindow and other functions that look at the SendStack % will work. /iexec-reenter { % obj => … mark /ParentDictArray where pop iexec-sends % obj mark context0 context1 … contextn { { % obj mark context0 context1 … contextn {func} 1 index mark eq { % obj mark {func} pop pop % obj {exec} stopped % … bool } { % obj mark context0 context1 … contextn {func} dup 3 -1 roll send % … } ifelse } dup exec } MumbleFrotz ?iexec-handle-error } def

iexec-array-like-types begin /arraytype true def /packedarraytype true def end % iexec-array-like-types

/iexec-token { % token => … dup xcheck { % This is the “weird” thing about PostScript: % If object is isn’t an executable array, execute it, else push it. //iexec-array-like-types 1 index type known not { PushExec } if } if } def

iexec-types begin

/nametype { % name => … pause iexec-continue-names? { % We push a dummy name continuation on the exec stack here to % help with debugging, by making stack dumps more informative… 10 dict begin /continuation /name def /continue { % dict pop } def /name 1 index def /namestring { /name load cvlit (name: % done) sprintf } def currentdict cvx PushExec end } if //iexec-names 1 index known { % name //iexec-names exch get % func exec % } { % name {{load}stopped} MumbleFrotz { true ?iexec-handle-error } { PushExec } ifelse } ifelse } def

/arraytype { % array => … iexec-continue-procs? { 10 dict begin /continuation /procedure def /proc exch def /i 0 def /len /proc load length def /continue { % dict => - begin i len lt { currentdict cvx PushExec /proc load i get iexec-token /i i 1 add def } if end } def /namestring { (procedure % @ %: %) [ /proc load i 1 index length 1 index gt { 2 copy get } (done) ifelse ] sprintf } def currentdict cvx PushExec end } { dup length dup 0 eq { % array length pop pop % } { % array length 1 eq { % array 0 get % iexec-token % } { % array dup 0 get % array head % push rest of array to execute later exch 1 1 index length 1 sub getinterval % head tail PushExec % head iexec-token % } ifelse } ifelse } ifelse } def

/packedarraytype /arraytype load def

/stringtype { % string => … dup token { % string rest token exch dup length 0 eq { pop } { PushExec } ifelse % string token exch pop % token iexec-token % … } { % str dup length 0 eq { pop % } { % str /syntax signal-error } ifelse } ifelse } def

/filetype { % file => - dup token { % file token exch dup % token file file status { PushExec } { pop } ifelse % token iexec-token % … } { % file dup status { /syntax signal-error } { pop } ifelse } ifelse } def

/operatortype { % operator => - //iexec-operators 1 index known { //iexec-operators exch get exec } { {{exec}stopped} MumbleFrotz ?iexec-handle-error } ifelse } def

/dicttype { % dict => - dup /continuation known { dup /continue get exec } if } def

end % iexec-types

iexec-operators begin

/exec load { % obj => - PushExec } def

/if load { % bool proc => - exch { PushExec } { pop } ifelse } def

/ifelse load { % bool trueproc falseproc 3 -1 roll { exch } if % wrongproc rightproc PushExec pop } def

iexec-single-forall-types begin {/arraytype /packedarraytype /stringtype} {true def} forall end % iexec-single-forall-types

/forall load { % obj proc => - 10 dict begin /continuation /forall def /proc exch def /obj exch cvlit def /i 0 def //iexec-single-forall-types obj type known { /continue { % dict => - begin i obj length lt { currentdict cvx PushExec obj i get /proc load PushExec /i i 1 add def } if end } def /namestring { (forall: proc=% obj=% @ %: %) [ /proc load /obj load i 1 index length 1 index gt { 2 copy get } (done) ifelse ] sprintf } def } { /keys [ obj {pop} forall ] def /continue { % dict => - begin i obj length lt { currentdict cvx PushExec keys i get % key obj 1 index get % key val /proc load PushExec /i i 1 add def } if end } def /namestring { (forall: proc=% obj=% @ %: %) [ /proc load /obj load keys i 1 index length 1 index gt { get 2 copy get } { pop null (done) } ifelse ] sprintf } def } ifelse currentdict cvx PushExec end } def

/for load { % first step last proc 10 dict begin /continuation /for def /proc exch def /last exch def /step exch def /first exch def /i first def /continue { % dict => - begin i last step 0 gt {le} {ge} ifelse { currentdict cvx PushExec i /proc load PushExec /i i step add def } if end } def /namestring { (for: proc=% first=% step=% last=% i=%) [/proc load first step last i] sprintf } def currentdict cvx PushExec end } def

/repeat load { 10 dict begin /continuation /repeat def /proc exch def /times exch def /i 0 def /continue { % dict => - begin i times lt { currentdict cvx PushExec /proc load PushExec /i i 1 add def } if end } def /namestring { (repeat: proc=% times=% i=%) [/proc load times i] sprintf } def currentdict cvx PushExec end } def

/loop load { 10 dict begin /continuation /loop def /proc exch def /continue { % dict => - begin currentdict cvx PushExec /proc load PushExec end } def /namestring { /proc load (loop: proc=%) sprintf } def currentdict cvx PushExec end } def

/pathforallvec load { %… } def

iexec-exit-stoppers begin {/forall /for /repeat /loop /pathforallvec} {true def} forall end % iexec-exit-stoppers

/exit load { { ExecSP 0 lt { % exit out of interpreter? true exit } { PopExec % obj dup dup xcheck exch type /dicttype eq and { % obj dup /continuation known { dup /continuation get iexec-exit-stoppers exch known { pop false exit } { pop } ifelse } { pop } ifelse } { % obj pop } ifelse } ifelse } loop

{ {exit} exit } if

} def

/stop load { { ExecSP 0 lt { % stop out of interpreter? true exit } { PopExec % obj dup dup xcheck exch type /dicttype eq and { % obj dup /continuation known { dup /continuation get /stopped eq { pop true false exit } { pop } ifelse } { pop } ifelse } { % obj pop } ifelse } ifelse } loop

{ {stop} exit } if

} def

/stopped load { % proc 10 dict begin /continuation /stopped def /continue { % dict => - pop false } def /proc 1 index def % debugging /namestring { /proc load (stopped: proc=%) sprintf } def currentdict cvx PushExec PushExec end } def

/send load { % <args> message object => <results> { currentdict } MumbleFrotz % message object context 2 copy eq { % message object context pop pop cvx PushExec } { % message object context 10 dict begin /continuation /send def /context exch dup /ParentDictArray known not { pop null } if def % message object /object exch def % message /message 1 index def % message /continue { % cdict => - { % cdict ParentDictArray dup type /arraytype ne { % X11/NeWS /ParentDictArray get length 1 add } { length } ifelse 1 add {end} repeat /context get % context dup null eq { % context pop % } { % idict context dup /ParentDictArray get {begin} forall begin % } ifelse % } MumbleFrotz } def /unwind /continue load def /namestring { (send: message=% object=% context=%) [/message load object context] sprintf } def currentdict cvx PushExec object context % message object context end % of cdict { null ne { ParentDictArray length 1 add {end} repeat } if dup /ParentDictArray get dup type /arraytype ne { % X11/NeWS dup /ParentDictArray get {begin} forall begin begin % message } { {begin} forall begin % message } ifelse } MumbleFrotz % message cvx PushExec % } ifelse } def

% supersend (operator in X11/NeWS, proc in 1.1?)

/currentfile load { % => file null ExecStack length 1 sub -1 0 { ExecStack exch get % obj dup type /filetype eq { exit } { pop } ifelse } for dup null eq { pop currentfile } { exch pop } ifelse } def

% We have to have the send contexts set up right when we do a fork, since % the child process inherits them. (i.e. so ThisWindow works) /fork load { {fork} iexec-reenter } def

/countexecstack load { /countexecstack dbgbreak } def

/quit load { /quit dbgbreak } def

end % iexec-operators

iexec-names begin

/sendstack { [ iexec-sends currentprocess /SendContexts get aload pop ] } def

/iexecing? true def

% meta-exec is a hook back up to the interpreter context. /meta-exec { exec } def

/append { {{append} stopped} MumbleFrotz ?iexec-handle-error } def

/sprintf { {{sprintf} stopped} MumbleFrotz ?iexec-handle-error } def

% execstack

end % iexec-names

/iexec-trace-changes { iexec-operators begin /def load {(/% % def\n) [3 index 3 index] dbgprintf def } def /store load {(/% % store\n) [3 index 3 index]dbgprintf store} def /put load {(% /% % put\n) [4 index 4 index 4 index]dbgprintf put} def end } def

end % systemdict