Update of /cvsroot/pure-data/externals/miXed/pddp In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv15441/pddp

Added Files: Makefile Makefile.objects Makefile.sources build_counter notes.txt pddp-all.exclude pddp-help.include pddp-shared.include pddp-test.exclude pddp-vicious.exclude pddpboot.tcl pddpclient.tcl pddplink.c pddpserver.tcl Log Message: toxy alpha17 and pddp alpha1 (see notes.txt for toxy, pddp and shared)

--- NEW FILE: pddp-test.exclude --- *~ import-result.pd import-debug.pd temporary temporary/*

--- NEW FILE: pddp-all.exclude --- *~ *.o *.gz *.html *.out ref ref/* dumpsetups

--- NEW FILE: pddpboot.tcl --- #!/bin/sh # \ exec tclsh "$0" -- "$@"

# Synopsis # test run: # ./pddpboot.tcl [root [port [path]]] # from Pd: # source pddpboot.tcl # ::pddp::srvUse root (or ::pddp::srvStart root [port]) # ::pddp::cliOpen path # ... (more "::pddp::cliOpen" calls) ... # ::pddp::srvStop

if {[namespace exists ::pddp]} { ;# created by pddplink's setup puts stderr "Booting pddp" set ::pddp::testrun 0 } else { puts stderr "Booting pddp, test run..." namespace eval ::pddp { variable testrun 1 } }

puts stderr "current directory: [pwd]"

source pddpclient.tcl source pddpserver.tcl

if {[info exists ::pddp::theDir]} { puts stderr "restoring directory: $::pddp::theDir" cd $::pddp::theDir unset ::pddp::theDir }

--- NEW FILE: Makefile.sources --- TYPES = PDDPLINK

PDDPLINK_SOURCES = pddplink.c

--- NEW FILE: Makefile --- ROOT_DIR = .. redefault: pddpboot default

pddpboot: $(ROOT_DIR)/bin/pddpboot.tcl \ $(ROOT_DIR)/bin/pddpclient.tcl $(ROOT_DIR)/bin/pddpserver.tcl

$(ROOT_DIR)/bin/%.tcl: %.tcl cp $< $@

include $(ROOT_DIR)/Makefile.common

--- NEW FILE: pddplink.c --- /* Copyright (c) 2005 krzYszcz and others. * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */

#include <stdio.h> #include <string.h> #include "m_pd.h" #include "m_imp.h" /* FIXME need access to c_externdir... */ #include "g_canvas.h" #include "common/loud.h" #include "build_counter"

#ifdef KRZYSZCZ //#define PDDPLINK_DEBUG #endif

enum { PDDPLINK_PD, PDDPLINK_HTML }; /* LATER add others */

typedef struct _pddplink { t_object x_ob; t_glist *x_glist; int x_isboxed; t_symbol *x_dirsym; t_symbol *x_ulink; t_atom x_openargs[2]; int x_linktype; int x_ishit; } t_pddplink;

static t_class *pddplink_class;

/* FIXME need access to glob_pdobject... */ static t_pd *pddplink_pdtarget(t_pddplink *x) { t_pd *pdtarget = gensym("pd")->s_thing; if (pdtarget && !strcmp(class_getname(*pdtarget), "pd")) return (pdtarget); else return ((t_pd *)x); /* internal error */ }

static void pddplink_anything(t_pddplink *x, t_symbol *s, int ac, t_atom *av) { if (x->x_ishit) { startpost("pddplink: internal error (%s", (s ? s->s_name : "")); postatom(ac, av); post(")"); } }

static void pddplink_click(t_pddplink *x, t_floatarg xpos, t_floatarg ypos, t_floatarg shift, t_floatarg ctrl, t_floatarg alt) { x->x_ishit = 1; switch (x->x_linktype) { case PDDPLINK_PD: typedmess(pddplink_pdtarget(x), gensym("open"), 2, x->x_openargs); break; case PDDPLINK_HTML: sys_vgui("after 0 {::pddp::cliOpen %s}\n", x->x_ulink->s_name); break; } x->x_ishit = 0; }

#ifdef PDDPLINK_DEBUG static void pddplink_debug(t_pddplink *x) { } #endif

static void pddplink_free(t_pddplink *x) { }

static void *pddplink_new(t_symbol *s1, t_symbol *s2) { t_pddplink *x = (t_pddplink *)pd_new(pddplink_class); t_symbol *dirsym; x->x_glist = canvas_getcurrent(); x->x_isboxed = (s2 == gensym("box")); x->x_dirsym = canvas_getdir(x->x_glist); /* FIXME */ if (!s1 || s1 == &s_) { x->x_linktype = PDDPLINK_HTML; x->x_ulink = gensym("index.html"); } else { int len = strlen(s1->s_name); if (len > 3 && !strcmp(s1->s_name + len - 3, ".pd")) x->x_linktype = PDDPLINK_PD; else x->x_linktype = PDDPLINK_HTML; x->x_ulink = s1; } SETSYMBOL(&x->x_openargs[0], x->x_ulink); SETSYMBOL(&x->x_openargs[1], x->x_dirsym); x->x_ishit = 0; if (x->x_isboxed) { inlet_new((t_object *)x, (t_pd *)x, 0, 0); outlet_new((t_object *)x, &s_anything); } if (x->x_linktype == PDDPLINK_HTML) sys_vgui("after 0 {::pddp::srvUse %s}\n", x->x_dirsym->s_name); return (x); }

void pddplink_setup(void) { t_symbol *dirsym; post("this is pddplink %s, %s %s build...", PDDP_VERSION, loud_ordinal(PDDP_BUILD), PDDP_RELEASE); pddplink_class = class_new(gensym("pddplink"), (t_newmethod)pddplink_new, (t_method)pddplink_free, sizeof(t_pddplink), CLASS_NOINLET | CLASS_PATCHABLE, A_DEFSYM, A_DEFSYM, 0); class_addanything(pddplink_class, pddplink_anything); class_addmethod(pddplink_class, (t_method)pddplink_click, gensym("click"), A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, 0); #ifdef PDDPLINK_DEBUG class_addmethod(pddplink_class, (t_method)pddplink_debug, gensym("debug"), 0); #endif dirsym = pddplink_class->c_externdir; /* FIXME */ sys_vgui("namespace eval ::pddp {variable theDir [pwd]}; cd %s\n", dirsym->s_name); sys_gui("after 0 {source pddpboot.tcl}\n"); }

--- NEW FILE: pddpserver.tcl --- # pddpserver.tcl

# Synopsis # not to be run by itself (see pddpboot.tcl)

# based on:

# Simple Sample httpd/1.[01] server # Stephen Uhler (c) 1996-1997 Sun Microsystems

# http://cvs.sourceforge.net/viewcvs.py/tclhttpd/tclhttpd/bin/mini/mini1.1.tcl

# modified by krzYszcz (2005): # putting per-server data and all commands in a namespace "::pddp" # supporting sourcing from within Pd, through the "pddpboot.tcl" wrapper # inserting the .pd handler # lots of other changes, too many to list here (run "diff" if curious...)

if {![namespace exists ::pddp]} { puts stderr "Error: invalid invocation of pddpserver (boot pddp first)" puts stderr "exiting..." exit 1 }

if {$::pddp::testrun} { ;# true if sourced from standalone "pddpboot.tcl" puts stderr "Loading pddpserver, test run..." proc bgerror {msg} { global errorInfo puts stderr "bgerror: $msg\n$errorInfo" } } else { puts stderr "Loading pddpserver" catch {console show} }

namespace eval ::pddp { variable thePort 8080 variable theState variable theMimeTypes variable theErrors variable theErrorFormat

# "theState" contains the server state: # root: the root of the document directory # default: default document name # listen: the main listening socket id # naccepts: a count of accepted connections so far # maxtime: the max time (msec) allowed to complete an http request # maxused: the max # of requests for a socket array set theState { root "" default index.html listen "" naccepts 0 nrequests 0 nerrors 0 maxtime 600000 maxused 25 bufsize 32768 }

set theState(root) $env(HOME)

array set theMimeTypes { {} text/plain .txt text/plain .html text/html .gif image/gif .jpg image/jpeg .pd text/html }

# HTTP/1.[01] error codes (the ones we use) array set theErrors { 204 {No Content} 400 {Bad Request} 404 {Not Found} 405 {Method Not Allowed} 408 {Request Timeout} 411 {Length Required} 419 {Expectation Failed} 500 {Internal Server Error} 503 {Service Unavailable} 504 {Service Temporarily Unavailable} 505 {HTTP Version Not Supported} }

# Generic error response set theErrorFormat { <title>Error: %1$s</title> Got the error: <b>%2$s</b><br> while trying to obtain <b>%3$s</b> } }

proc ::pddp::srvUse {{root {}} {port 8080}} { variable theState if {[string length $theState(listen)]} { if {[string length $root] && ![string equal $root $theState(root)]} { srvLog $theState(listen) Warning "Redirection attempt for $root" } } else { srvStart $root $port } }

# Start the server by listening for connections on the desired port.

proc ::pddp::srvStart {{root {}} {port 8080}} { variable thePort variable theState

puts stderr "Starting pddp server on [info hostname]" if {[string length $root]} { set theState(root) $root } # we do not handle multiple pddpservers, LATER rethink srvStop array set theState [list naccepts 0 nrequests 0 nerrors 0]

for { set thePort $port } {$thePort < 32767 } {incr thePort } { if {[catch {set theState(listen) \ [socket -server ::pddp::srvAccept $thePort]} res]} { if {$thePort == 0} { # FIXME this is a critical error set thePort 8080 } } else { break } } if {$thePort == 32767} { srvLog none Error "Could not find port available for listening" } else { if {$thePort == 0} { set thePort [lindex [fconfigure $theState(listen) -sockname] 2] } srvLog $theState(listen) Port $thePort srvLog $theState(listen) Root directory "$root" } after 120 update ;# FIXME might be needed on windows they say, test there return $thePort }

proc ::pddp::srvStop {} { variable thePort variable theState if {[string length $theState(listen)]} { if {[catch {close $theState(listen)} res]} { srvLog $theState(listen) Warning [list $res while closing socket] } else { srvLog $theState(listen) Closed. } set theState(listen) "" update } }

# Accept a new connection from the server and set up a handler # to read the request from the client.

proc ::pddp::srvAccept {sock ipaddr port} { variable theState variable theSockData$sock # reject remote requests, LATER revisit if {[string equal $ipaddr "127.0.0.1"]} { incr theState(naccepts) srvReset $sock $theState(maxused) srvLog $sock Connect $ipaddr $port } else { srvLog $sock Warning "rejecting remote connection request from $ipaddr" srvSockDone $sock 1 } }

# Initialize or reset the socket state

proc ::pddp::srvReset {sock nlft} { variable theState upvar 0 ::pddp::theSockData$sock sockData array set sockData [list state start linemode 1 version 0 nleft $nlft] set sockData(cancel) \ [after $theState(maxtime) [list srvTimeout $sock]] fconfigure $sock -blocking 0 -buffersize $theState(bufsize) \ -translation {auto crlf} fileevent $sock readable [list ::pddp::srvRead $sock] }

# Read data from a client request # 1) read the request line # 2) read the mime headers # 3) read the additional data (if post && content-length not satisfied)

proc ::pddp::srvRead {sock} { variable theState upvar 0 ::pddp::theSockData$sock sockData

# Use line mode to read the request and the mime headers

if {$sockData(linemode)} { set readCount [gets $sock line] set state [string compare $readCount 0],$sockData(state) switch -glob -- $state { 1,start { if {[regexp {(HEAD|POST|GET) ([^?]+)??([^ ]*) HTTP/1.([01])} \ $line x sockData(proto) sockData(url) \ sockData(query) sockData(version)]} { set sockData(state) mime incr theState(nrequests) srvLog $sock Request $sockData(nleft) $line } else { srvError $sock 400 $line } } 0,start { srvLog $sock Warning "Initial blank line fetching request" } 1,mime { if {[regexp {([^:]+):[ ]*(.*)} $line {} key value]} { set key [string tolower $key] set sockData(key) $key if {[info exists sockData(mime,$key)]} { append sockData(mime,$key) ", $value" } else { set sockData(mime,$key) $value } } elseif {[regexp {^[ ]+(.+)} $line {} value] && \ [info exists sockData(key)]} { append sockData(mime,$sockData($key)) " " $value } else { srvError $sock 400 $line } } 0,mime { if {$sockData(proto) == "POST" && \ [info exists sockData(mime,content-length)]} { set sockData(linemode) 0 set sockData(count) $sockData(mime,content-length) if {$sockData(version) && \ [info exists sockData(mime,expect)]} { if {$sockData(mime,expect) == "100-continue"} { puts $sock "100 Continue HTTP/1.1\n" flush $sock } else { srvError $sock 419 $sockData(mime,expect) } } fconfigure $sock -translation {binary crlf} } elseif {$sockData(proto) != "POST"} { srvRespond $sock } else { srvError $sock 411 "Confusing mime headers" } } -1,* { if {[eof $sock]} { srvLog $sock Error "Broken connection fetching request" srvSockDone $sock 1 } else { puts stderr "Partial read, retrying" } } default { srvError $sock 404 "Invalid http state: $state,[eof $sock]" } }

# Use counted mode to get the post data

} elseif {![eof $sock]} { append sockData(postdata) [read $sock $sockData(count)] set sockData(count) [expr {$sockData(mime,content-length) - \ [string length $sockData(postdata)]}] if {$sockData(count) == 0} { srvRespond $sock } } else { srvLog $sock Error "Broken connection reading POST data" srvSockDone $sock 1 } }

# Done with the socket, either close it, or set up for next fetch # sock: The socket I'm done with # doclose: If true, close the socket, otherwise set up for reuse

proc ::pddp::srvSockDone {sock doclose} { variable theState upvar 0 ::pddp::theSockData$sock sockData

after cancel $sockData(cancel) set nleft [incr sockData(nleft) -1] unset sockData if {$doclose} { close $sock } else { srvReset $sock $nleft } return "" }

# A timeout happened

proc ::pddp::srvTimeout {sock} { srvError $sock 408 }

# FIXME test if "path" has its patch window already open... proc ::pddp::srvPdHandler {sock path} { set dir [file dirname $path] set tail [file tail $path] if {[catch {pd [concat pd open $tail $dir ;]}]} { srvError $sock 504 } else { srvError $sock 204 # FIXME raise; focus (test on windows) } }

# Handle file system queries. This is a place holder for a more # generic dispatch mechanism.

proc ::pddp::srvRespond {sock} { variable theState variable theUrlCache upvar 0 ::pddp::theSockData$sock sockData

regsub {(^http://%5B%5E/%5D+)?%7D $sockData(url) {} url if {[info exists theUrlCache($url)]} { set mypath $theUrlCache($url) } else { set mypath [srvUrl2File $theState(root) $url] if {[file isdirectory $mypath]} { append mypath / $theState(default) } set theUrlCache($url) $mypath } if {[string length $mypath] == 0} { srvError $sock 400 } elseif {![file readable $mypath]} { if {[string equal [file tail $mypath] "favicon.ico"]} { srvError $sock 204 ;# FIXME design something } else { srvError $sock 404 $mypath } } else { set ext [file extension $mypath]

if {[string equal $ext ".pd"]} { srvPdHandler $sock $mypath return }

puts $sock "HTTP/1.$sockData(version) 200 Data follows" puts $sock "Date: [srvGetDate [clock seconds]]" puts $sock "Last-Modified: [srvGetDate [file mtime $mypath]]" puts $sock "Content-Type: [srvContentType $ext]" puts $sock "Content-Length: [file size $mypath]"

## Should also close socket if recvd connection close header set doclose [expr {$sockData(nleft) == 0}]

if {$doclose} { puts $sock "Connection close:" } elseif {$sockData(version) == 0 && \ [info exists sockData(mime,connection)]} { if {$sockData(mime,connection) == "Keep-Alive"} { set doclose 0 puts $sock "Connection: Keep-Alive" } } puts $sock "" flush $sock

if {$sockData(proto) != "HEAD"} { set in [open $mypath] fconfigure $sock -translation binary fconfigure $in -translation binary fcopy $in $sock -command \ [list ::pddp::srvCopyDone $in $sock $doclose] } else { srvSockDone $sock $doclose } } }

# Callback when file is done being output to client # in: The fd for the file being copied # sock: The client socket # doclose: close the socket if true # bytes: The # of bytes copied # error: The error message (if any)

proc ::pddp::srvCopyDone {in sock doclose bytes {error {}}} { close $in srvLog $sock Done $bytes bytes srvSockDone $sock $doclose }

# Convert the file suffix into a mime type.

proc ::pddp::srvContentType {ext} { variable theMimeTypes set type text/plain catch {set type $theMimeTypes($ext)} return $type }

# Respond with an error reply # sock: The socket handle to the client # code: The httpd error code # args: Additional information for error logging

proc ::pddp::srvError {sock code args} { variable theState variable theErrors variable theErrorFormat upvar 0 ::pddp::theSockData$sock sockData

append sockData(url) "" incr theState(nerrors) set message [format $theErrorFormat $code $theErrors($code) $sockData(url)] append head "HTTP/1.$sockData(version) $code $theErrors($code)" \n append head "Date: [srvGetDate [clock seconds]]" \n append head "Connection: close" \n append head "Content-Length: [string length $message]" \n

# Because there is an error condition, the socket may be "dead"

catch { fconfigure $sock -translation crlf puts -nonewline $sock $head\n$message flush $sock } reason srvSockDone $sock 1 if {$code < 300} {set status Status} else {set status Error} srvLog $sock $status $code $theErrors($code) $args $reason }

# Generate a date string in HTTP format.

proc ::pddp::srvGetDate {seconds} { return [clock format $seconds -format {%a, %d %b %Y %T %Z}] }

# Log an Httpd transaction. # This should be replaced as needed.

proc ::pddp::srvLog {sock args} { puts stderr "pddp log ($sock): $args" }

# Convert a url into a pathname. (UNIX version only) # This is probably not right, and belongs somewhere else. # - Remove leading http://... if any # - Collapse all /./ and /../ constructs # - expand %xx sequences -> disallow "/"'s and "."'s due to expansions

proc ::pddp::srvUrl2File {root url} { regsub -all {//+} $url / url ;# collapse multiple /'s while {[regsub -all {/./} $url / url]} {} ;# collapse /./ while {[regsub -all {/..(/|$)} $url /\x81\1 url]} {} ;# mark /../ while {[regsub "/[^/\x81]+/\x81/" $url / url]} {} ;# collapse /../ if {![regexp "\x81|%2[eEfF]" $url]} { ;# invalid /../, / or . ? return $root[srvCgiMap $url] } else { return "" } }

# Decode url-encoded strings.

proc ::pddp::srvCgiMap {data} { regsub -all {([][$\])} $data {\\1} data regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data return [subst $data] }

if {$::pddp::testrun} { ;# true if tested as a standalone script if {$argc > 1} { set root [lindex $argv 1] set port [lindex $argv 2] if {![string is integer -strict $port]} { set port 8080 } } else { set root $env(HOME) set port 8080 } ::pddp::srvStart $root $port vwait forever }

--- NEW FILE: notes.txt --- TODO for pddp * pddplink: . standardize server's root directory (use $help_directory from pd.tk?) . nonboxed version

DONE for pddp

alpha1 * prototype versions of the external "pddplink" and two pd-gui extensions "pddpserver.tcl", "pddpclient.tcl"

--- NEW FILE: pddp-help.include ---

--- NEW FILE: build_counter --- #define PDDP_VERSION "0.1" #define PDDP_RELEASE "alpha" #define PDDP_BUILD 1

#if 0 PDDP_SNAPSHOT = 0.1-alpha1 #endif

--- NEW FILE: Makefile.objects --- PDDPLINK_OBJECTS = \ common/loud.o \ common/os.o

--- NEW FILE: pddp-shared.include --- shared/shared.h shared/common/loud.c shared/common/loud.h shared/common/os.c shared/common/os.h

--- NEW FILE: pddpclient.tcl --- # pddpclient.tcl

# Synopsis # not to be run by itself (see pddpboot.tcl)

if {![namespace exists ::pddp]} { puts stderr "Error: invalid invocation of pddpclient (boot pddp first)" puts stderr "exiting..." exit 1 }

if {$::pddp::testrun} { ;# true if sourced from standalone "pddpboot.tcl" puts stderr "Loading pddpclient, test run..." if {$argc > 3} { set path [lindex $argv 3] if {[string length $path]} { puts stderr "Scheduling "$path" for opening" after idle ::pddp::cliOpen $path } unset path } } else { puts stderr "Loading pddpclient" }

namespace eval ::pddp { variable theBrowserCommand

switch -- $::tcl_platform(platform) { unix { switch -- $tcl_platform(os) { Darwin { set theBrowserCommand "sh -c open %s" } Linux { foreach candidate \ {firefox mozilla galeon konqueror netscape lynx} { set browser [lindex [auto_execok $candidate] 0] if {[string length $browser]} { set theBrowserCommand "$browser %s &" break } } } } } windows { # should not this be just: [auto_execok start]? set theBrowserCommand \ "rundll32 url.dll,FileProtocolHandler file:%s &" } } }

proc ::pddp::cliError {err} { puts stderr "Error in pddpclient: $err" }

proc ::pddp::cliOpen {path} { if {[string first "://" $path] < 1} { if {[info exists ::pddp::thePort]} { set path "http://localhost:$::pddp::thePort/$path" } else { cliError "pddpserver not running" return } } variable theBrowserCommand if {[string length $theBrowserCommand]} { set command [format $theBrowserCommand $path] puts stderr "pddpclient: open $command" if {[catch {eval [list exec] $command} err]} { if {[lindex $::errorCode 0] eq "CHILDSTATUS"} { cliError "$err (child status [lindex $::errorCode 2])" } else { cliError $err } } } else { cliError "browser unavailable" } }

--- NEW FILE: pddp-vicious.exclude --- *~ old old/*