Updated 2013-01-18 15:40:46 by pooryorick ▲

Brian Theado - 28Sep04 - I swiped the code from wiki-reaper and modified it to execute the reaped code in a Tk-enabled safe interpreter instead of displaying the reaped code to stdout.

One nice improvement would be to change the code to use httpvfs combined with something like A collate/broadcast virtual filesystem, so the page doesn't have to be fetched each time it is to be executed.

It would also be nice to have a page or set of pages that listed the reapable/safe-interp runnable apps, so a clickable interface can be supplied by the program instead of having to look up page numbers.

The pages that will execute successfully will be a small subset of the reapable pages, because much of the code on the wiki uses commands that are not available in the safe interpreter. For some of these, maybe the code can be changed. For others, maybe a wrapper can be created that is still safe and allows the program to execute with reasonable functionality. One such wrapper for wm is provided below because the first several reapable pages I tried all used [wm title] to set their titles.

I only tried a few pages and here are the results. I didn't investigate any of the problems I encountered:

escargo 29 Sep 2004 - There's a long list of reapable pages that has been created and maintained on the wish-reaper page.
#!/bin/sh
# -*- tcl -*- \
exec tclsh $0 ${1+"$@"}

package require Tcl 8.3
package require Tk

if {[llength $argv] == 0} {
    puts stderr "usage: wiki-runner page ?page ...?"
    exit 1
}

if {![catch { package require nstcl-html }] &&
    ![catch { package require nstcl-http }]} {
    namespace import nstcl::*
} else {
    package require http

    proc ns_geturl {url} {
        set conn [http::geturl $url]
        set html [http::data $conn]
        http::cleanup $conn
        return $html
    }

    proc ns_striphtml {-tags_only html} {
        regsub -all -- {<[^>]+>} $html "" html
        return $html ;# corrected a typo here
    }

    proc ns_urlencode {string} {
        set allowed_chars  {[a-zA-Z0-9]}
        set encoded_string ""

        foreach char [split $string ""] {
            if {[string match $allowed_chars $char]} {
                append encoded_string $char
            } else {
                scan $char %c ascii
                append encoded_string %[format %02x $ascii]
            }
        }

        return $encoded_string
    }
}

proc output {data} {
    # we don't want to throw an error if stdout has been closed
    catch { puts $data }
}

# Save to a variable named output instead of displaying to stdout
proc output data {
   uplevel append output [list $data\n]
}

proc reap {page} {
    set url  http://wiki.tcl.tk/[ns_urlencode $page]
    set now  [clock format [clock seconds] -format "%e %b %Y, %H:%M" -gmt 1]
    set html [ns_geturl $url]

    # can't imagine why these characters would be in here, but just to be safe
    set html [string map [list \x00 "" \x0d ""] $html]
    set html [string map [list <pre> \x00 </pre> \x0d] $html]

    if {![regexp -nocase {<title>([^<]*)</title>} $html => title]} {
        set title "(no title!?)"
    }

    if {![regexp -nocase {<i>Updated on ([^G]+ GMT)} $html => updated]} {
        set updated "???"
    }

    output "#####"
    output "#"
    output "# \"$title\""
    output "# [string map [list wiki.tcl.tk] $url]"
    output "#"
    output "# Tcl code harvested on:  $now GMT"
    output "# Wiki page last updated: $updated"
    output "#"
    output "#####"
    output \n

    set html [ns_striphtml -tags_only $html]

    foreach chunk [regexp -inline -all {\x00[^\x0d]+\x0d} $html] {
        set chunk [string range $chunk 1 end-1]
        set chunk [string map [list "&quot;" \x22 \
                                    "&amp;"  &    \
                                    "&lt;"   <    \
                                    "&gt;"   >] $chunk]

        foreach line [split $chunk \n] {
            if {[string index $line 0] == " "} {
                set line [string range $line 1 end]
            }

            output $line
        }
    }

    output \n
    output "# EOF"
    output \n
    return [list $title $output]
}
proc sandbox {title code} {
    package require Tk
    wm withdraw .
    set interp [safe::interpCreate]
    safe::loadTk $interp

    # Many programs will try to set their window title which isn't allowed
    # in a safe interpreter, so stub out the wm command
    $interp eval {proc wm args {}}
    wm title .safe$::safe::tkSafeId $title
    $interp eval $code 
}
wm withdraw .
catch {console show}
foreach page $argv {
    puts "Reaping page $page"
    eval sandbox [reap $page]
}

dizzy 17 Nov 2006 - Doesn't work for me, it breaks on the wm withdraw . command because the Tk package hasn't been loaded yet. I have put a catch around the wm command and also added some code to exit the program when there are no applets left running:
catch {wm withdraw .}
catch {console show}
foreach page $argv {
    puts "Reaping page $page"
    eval sandbox [reap $page]
}
proc shutdown {} {
    if {[catch {set children [winfo children .]}] || $children == {}} {
        exit
    }
    after 100 shutdown
}
shutdown

Category ApplicationCategory Wikit