[plt-scheme] gdb wrapper and typing

Thaddeus L. Olczyk wrote:

> 1) He mentioned a Web server wrapper for gdb. Where can I get
>     the source?

It's not in the distribution.

I'm dreafully busy right now, so I don't have time to update this code
for the latest server release; it dates back to 2002, and may not run
right out of the box.  If you do patch it, however, I'd be happy to
get an updated copy back.

This version re-runs the gdb session every time.  You can avoid doing
that by opening the gdb session only once (since a PLT Scheme Web
program can maintain state), but then if you use the Back button or
perform other interactions, the results on screen can appear
inconsistent.

You will need to edit the PROGRAM-NAME and ARGUMENT-LIST variables
below.  I put them in the middle of the code on purpose: all the code
above that is entirely *in*dependent of gdb (it could be applied to
some other program, such as bash, say), while all the code below it
(other than the last line, which kicks off computation) is entirely
dependent on gdb (so it'd need to be retargeted for other apps).

Shriram

----------------------------------------------------------------------

(require (lib "unitsig.ss"))
(require (lib "cgi-sig.ss" "server"))
(require (lib "process.ss"))

(let ([process* process*])

  (unit/sig () (import cgi^)

    (define (generate-i/o-page all-commands k-url)
      `(html
	(head
	 (title "Interaction"))
	(body
	 ,@(map (lambda (interaction-pair)
		  `(p
		    (strong (tt ,(car interaction-pair)))
		    (br)
		    (blockquote (pre ,(cdr interaction-pair)))))
		(i/o-loop all-commands))
	 (form ((action ,k-url)
		(method "post"))
	       (p
		(input [(type "text")
			(name "new-input")
			(size "40")
			(value "")])
		(input [(type "SUBMIT")
			(name "submit")
			(value "Submit")]))))))

    (define (driver-loop commands-so-far)
      (let-values
       ([(method url headers bindings)
	 (send/suspend
	  (lambda (k-url)
	    (generate-i/o-page commands-so-far k-url)))])
       (driver-loop (append commands-so-far
			    (list (cdr (assoc 'new-input bindings)))))))

    (define (i/o-loop all-commands)
      (let-values
       ([(stdout stdin pid stderr status)
	 (apply values
		(apply process* 
		       PROGRAM-NAME
		       ARGUMENT-LIST))])
       (begin0
	(cons (cons "" (read-until-prompt stdout stderr))
	      (map (lambda (cmd)
		     (cons cmd
			   (get-program-output cmd stdin stdout
					       pid stderr status)))
		   all-commands))
	(close-input-port stdout)
	(close-output-port stdin)
	(close-input-port stderr))))

    (define PROGRAM-NAME  "/pro/gnome/bin/gdb")
    (define ARGUMENT-LIST 
      (list "/u/ptg/plt/.bin/sparc-solaris/mzscheme"
	    "/u/sk/Topics/PADL2002/Web/core"))

    (define GDB-PROMPT (regexp "\\(gdb\\) $"))
    (define GDB-PROMPT-SIZE 6)

    (define (read-until-prompt stdout stderr)
      (string-append
       (let loop ([chars '()])
	 (cond
	  [(char-ready? stdout)
	   (loop (cons (read-char stdout) chars))]
	  [else
	   (cond
	    [(regexp-match GDB-PROMPT
			   (list->string (reverse chars)))
	     (list->string (reverse (list-tail chars GDB-PROMPT-SIZE)))]
	    [else
	     (loop (cons (read-char stdout) chars))])]))
       (let loop ([chars '()])
	 (cond
	  [(char-ready? stderr)
	   (loop (cons (read-char stderr) chars))]
	  [else
	   (list->string (reverse chars))]))))

    (define (get-program-output cmd stdin stdout pid stderr status)
      (display cmd stdin)
      (newline stdin)
      (read-until-prompt stdout stderr))

    (driver-loop '())

    ))