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 (C) 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