REBOL [
Title: "REBOL Blogger"
Author: "Carl Sassenrath"
Version: 1.4.1
Date: 6-Oct-2006
File: %new-blog.r
Purpose: {
The blog system written and used by Carl Sassenrath,
REBOL's creator. This script will let you post and
update blogs on your website using just a web browser.
Generates summary and index pages, blog searches, etc.
Extensible with Makedoc2 for more formatting options.
}
Dependencies: {
For RSS, you will need emit-rss.r from Christopher Ross-Gill.
For makedoc format, you need makedoc2.r from Carl Sassenrath.
For a REBOL powered webserver, you will need ServeIt.r from Dirk Weyand.
}
License: {
BSD. No warranties. Use at your risk.
Do not remove credit to the authors.
Do not change the official source URL.
}
Library: [
level: 'intermediate
platform: 'all
type: [tool]
domain: [cgi html http]
tested-under: [core 2.5.6 on "Linux x86"]
support: none
license: 'BSD
see-also: none
]
]
; Blog.r Feature Summary:
; 1. Allows remote blogging via html forms.
; 2. Automatically builds main blog page.
; 3. Creates a dated index to all blogs.
; 4. Creates links to and between blogs.
; 5. Use your website's standard page template.
; 6. Supports ranked searches on blogs.
; 7. Provides a handy blog-content backup method.
; 8. Provides a form for feedback (but feedback system
; is not a standard part of this blog.r script).
; 9. No database engine is needed.
; 10. Optionally generates static blog pages. [V1.3.0]
; 11. Supports multiple blogs on same site. [V1.3.0]
; 12. Supports rss-feeds [V1.4.0]
; 12. Supports comments on each blogging article [V1.4.1]
; 13. Works now smoothly with Serve-It! v2.7.4!
; All modifications of Carls Blogger script are marked with ; (TGD) ;
; Download Serve-It! @ http://www.TGD-Consulting.de/Download.html#ServeIt
; Installation: (only step 1 is still necassary for the usage with Serve-It!)
; 1. Upload this script to your CGI script directory.
; 2. Verify that you have a copy of REBOL/Core on your server.
; 3. Add a top line to point to REBOL/Core. Something like:
; #!/usr/bin/rebol -cs
; 4. Change permissions (chmod 755) for blog.r to let it run.
; 5. Test it from a browser. If it has errors, you may need to
; create the blog-dir dir and blog-reads file manually then
; give them proper permissions (chmod 777 or 666). Be careful.
; Read http://www.rebol.com/docs/cgi2.html for details.
cgi-obj: system/options/cgi
; (TGD) ; ;-- Special shortcut needed to fetch source code text:
; (TGD) ; if cgi-obj/request-method = "GET" [
; (TGD) ; cgi: decode-cgi cgi-obj/query-string
; (TGD) ; if find cgi to-set-word 'get-source [
; (TGD) ; print "content-type: text/plain^/"
; (TGD) ; print read %blog.r ; use REBOL read url to save it
; (TGD) ; quit
; (TGD) ; ]
; (TGD) ; ]
; (TGD) ; This is handled within do-cgi now, see below.
; (TGD) ; print "content-type: text/html^/" ; activate web server content output
;-- Mezz Functions ----------------------------------------------------------- ; (TGD) ;
; (TGD) ;
if not value? 'attempt [ ; (TGD) ;
attempt: func [ ; (TGD) ;
blk [block!] ; (TGD) ;
/local rc ; (TGD) ;
][ ; (TGD) ;
if error? rc: try blk [rc: none] ; (TGD) ;
return rc ; (TGD) ;
] ; (TGD) ;
] ; (TGD) ;
if not value? 'remove-each [ ; (TGD) ;
remove-each: func [ ; (TGD) ;
'word [word! block! get-word!] ; (TGD) ;
data [series!] ; (TGD) ;
body [block!] ; (TGD) ;
/local i ; (TGD) ;
][ ; (TGD) ;
i: 1 ; (TGD) ;
foreach :word copy data compose [ ; (TGD) ;
either (body) [ ; (TGD) ;
remove at data i ; (TGD) ;
] [ ; (TGD) ;
i: i + 1 ; (TGD) ;
] ; (TGD) ;
] ; (TGD) ;
data ; (TGD) ;
] ; (TGD) ;
] ; (TGD) ;
remote-ip: attempt [to-tuple cgi-obj/remote-addr]
;-- Configuration ------------------------------------------------------------
; Automatically detect when running on client in test mode.
; (Causes the tested page to be displayed in the browser.)
test-mode: not cgi-obj/request-method
; The website URL where your blog is located:
; Example: blog-site: http://www.rebol.net
blog-site: http://www.TGD-Consulting.de ; (TGD) ;
; Absolute path to the blog CGI script on your server. You can change this
; if you want more than one REBOL blog on your web site.
; Example: blog-cgi: %/cgi-bin/blog.r
blog-cgi: %/cgi-bin/new-blog.r ; (TGD) ;
; Full blog URL (you don't normally need to change this):
blog-url: blog-site/:blog-cgi
; Where raw blog text files are stored relative to this script:
; Example: blog-dir: %blogs/
blog-dir: %../blog/blogs/
; Where blog HTML pages are cached after they are generated.
; This should be under the root directory of your website.
; Make sure it has permissions to allow CGI file writing.
; Set this to NONE if you always want dynamic (CGI) pages.
; Example: blog-root: %../html/blogs/
blog-root: %../blog/html/
; The URL path to the above cache directory:
blog-path: %/blog/html/
blog-active: false ; always use CGI to view blog
; The name of the main blog file/page within the above cache:
main-file: %blog-index.html
; File that holds the blog access counter:
blog-counter: %blog-reads
; An optional RSS feed file for the blog. Relative to blog-root
; above. Requires "Emit RSS" script from Christopher Ross-Gill.
rss-file: %blog-rss.xml
rss-url: join blog-site %/blog/html/rss.html
full-rss: true ; The entire article goes into RSS
; How many blogs are printed on the main page:
max-blogs: 3
; How many blogs are indexed at the bottom of the main page:
max-links: 10
; Where comment files are stored relative to this script:
; Example: blog-dir: %blog-cmts/
cmts-dir: %../blog/blog-cmts/
cmts-log: cmts-dir/log.r
; The blog author/admin IP address. Only this address gets to post.
; If your client uses dynamic IP, then this will not work and you
; will need to use a username/pass with cookies to protect your blog.
admin-ip: any [attempt [load %admin-ip] 192.168.1.1]
if string? admin-ip [admin-ip: to-tuple admin-ip] ; Tuple, not a string!
; The name of the blogger:
author: "Your Name Here"
author-title: "Your Title Here"
author-email: "no-spam@Your.Domain"
; IMG source link to author's photo location:
photo-file: %/photos/you.jpg
photo-text: "You at ..."
photo-link: %/photos/youat.jpg
; The name of the organization:
organization: "Your Company Here"
; Copyright name:
copyright: reform [author now/year]
; The titles of generated pages:
title: context [
main-page: "Your Name's Blog"
index-page: "Complete Index of Your Name Blogs:"
search-page: "Results of Search:"
feedback-page: "Send Feedback to Your Name"
]
; The meta decscription needed for search engines:
meta-description: trim/lines {
Comments and ideas provided by Your Name via the
REBOL Blogger.
}
; The purpose of the blog ; (TGD) ;
purpose: meta-description ; (TGD) ;
; Some links to other sites, blogs, etc. [URI Description] ; (TGD) ;
links: [ ; (TGD) ;
http://www.rebol.net "The REBOL Developer Network" ; (TGD) ;
http://www.rebol.net/cgi-bin/r3blog.r "REBOL 3.0 Front Line" ; (TGD) ;
] ; (TGD) ;
; Blog page contents can be formatted with makedoc2 allowing nicer
; formatting of examples, etc. If the file below is not found, the
; default formatter will be used (just paragraph separation).
makedoc-script: %makedoc2.r
; Automatically detect when running on client in test mode.
; (Causes the tested page to be displayed in the browser.)
test-mode: not cgi-obj/request-method
; Where the official version of the blog.r source is stored:
source-url: http://www.rebol.net/cgi-bin/blog.r?source=1
get-source-url: http://www.rebol.net/cgi-bin/blog.r?get-source=1
; Reject comments that include any of these strings (unless admin posted):
comment-restrict: reduce [
to-string #{6675636B}
to-string #{73686974}
to-string #{766961677261}
]
comment-name-restrict: join comment-restrict [
"sassenrath"
]
; Reject comment spammer, ; (TGD) ;
comment-max: 20 ; only 20 comments are allowed per day ; (TGD) ;
;-- HTML Templates -----------------------------------------------------------
;
; If you want to, you can cut and paste these into most HTML page editors to
; help revise them to get what you want. Just be sure to keep the {} braces.
; The name of the HTML template used for the look & feel. Fields within this
; template use the standard $variable format. See show-page function below.
blog-template: %blog-template.html
; The default HTML template if the above file cannot be found. This also shows
; the variable format needed to create your own blog-template.html file:
html-template: {
$title
$title
$content
$date - $edit -
Blogger by REBOL - Serve-It! by TGD-Consulting
}
; The HTML boilerplate used at the top of the first page:
html-main-boiler: [{
}] ; The HTML boilerplate used at the top of each separate blog page: html-blog-boiler: [{
}] ; The HTML form used for inputing new blogs: html-edit-form: [{
}] ; The HTML form used for feedback replies: html-reply-form: [{ }] html-comment-form: [{ } ] button-for-post: ;-- Utility Functions -------------------------------------------------------- abort: false ; (TGD) ; quit shutdowns REBOL based Servers html: make string! 8000 emit: func [data] [repend html data] joins: func [data] [to-string reduce data] optional: func [cond block] [ ; Returns either the block contents or empty string: either cond block [""] ] limit: func [size str] [ either (length? str) > size [copy/part str size][str] ] safe-html: func [text] [ ; Generate a "safe" html page: foreach [str code] [ "&" "&" "<" "<" ">" ">" ][replace/all text str code] text ] to-GMT: func [date] [ ; Extract a GMT time from DATE optional date/time [ date: fourth date - date/zone date/3: 0 ; remove seconds reform [date "GMT"] ] ] file-num: func [n] [ ; Output 000n file name format: n: form n insert/dup n "0" 4 - length? n to-file n ] validate-user: does [ ; Validate user has permission to post: if test-mode [return true] if all [admin-ip remote-ip <> admin-ip] [ show-error "Permission denied." ] ] filter-tags: func [ "Filter HTML to only allow specific tags." page [string!] /local block ][ init-filter-tags block: load/markup page remove-each item block [ if tag? item [ all [ not find item #"<" ; No hiding evil tags in good tags not any [ find tags-allowed item ; Allow : all [item/1 = slash find tags-allowed next item] foreach tag ext-tags [ if find/match item tag [break/return true] ] ] ] ] ] replace/all to-string block #"@" "(at)" ] init-filter-tags: does [ ; Globals: if value? 'tags-allowed [exit] tags-allowed: [
] tags-list: make block! length? tags-allowed foreach tag tags-allowed [append tags-list to-string tag] tags-list: form tags-list ext-tags: make block! length? tags-allowed ; E.g. foreach tag tags-allowed [append ext-tags append to-string tag " "] ] nice-date: func [ "Convert date/time to a friendly format." date [date!] /local n day time diff ][ n: now time: date/time diff: n/date - date/date if diff < 2 [return "Today"] if diff < 3 [return "Yesterday"] if diff < 7 [return "This week"] return "" ] find-any: func [ "Search a string for a variety of substrings." string block ][ foreach item block [ if find/any string item [return item] ] none ] ;-- HTML Page Output --------------------------------------------------------- show-page: func [title /edit link /main /build file /local template tag] [ ; Show page thru CGI or locally in browser (for testing) template: attempt [read blog-template] ; fails for NONE if not template [template: trim/auto copy html-template] ; use default if all [main meta-description] [ tag: build-tag [meta name "description" content (meta-description)] attempt [insert insert find/tail template newline tag] ] title: joins title replace/all template "$title" title if build [edit: true link: file] if not link [link: 'new] tag: rejoin [{Edit}] replace template "$edit" tag replace/all template "$date" now/date replace/all template "$source" source-url replace template "$content" html if blog-root [ if edit [write join blog-root/:link ".html" template] if all [main remote-ip = admin-ip][ ; Patch for Google indexing problem: write blog-root/:main-file template ] ] if build [exit] ; just an update either test-mode [ write %temp-page.html template browse %temp-page.html ][ print template ] abort: true ; (TGD) ; ; (TGD) ; quit ] show-error: func [msg] [ ; Output an error page: emit emit msg ; (do not combine) emit show-page "Blogger Error:" ] ;-- Blog File Handling ------------------------------------------------------- blog-obj: context [file: date: title: text: cmt: comments: none] load-blog: func [file /local blog] [ if attempt [ blog: load/all join blog-dir file ; (TGD) ; blog: construct/with blog blog-obj blog: make blog-obj blog ; (TGD) ; all [ blog/file: file date? blog/date string? blog/text ] ][ load-comment blog blog ] ] save-blog: func [file date title text /local blog files] [ validate-user if not abort [ ; (TGD) ; date: to-date date blog: load-blog file if not blog [ files: sort/reverse load blog-dir file: files/1 file: either file [1 + to-integer file] [1] file: file-num file ] save join blog-dir file compose [ date: (date) title: (title) text: (text) ] build-rss-feed file ] ; (TGD) ; ] find-blog: func [blog strs /local rank text][ ; Ranks blog contents during a search: rank: 0 foreach str strs [ if find/any blog/title str [rank: rank + 4] text: blog/text while [text: find/any/tail text str] [text: copy text rank: rank + 1] ; (TGD) ; avoid infinte loop ] rank ] backup-blogs: func [start /local files] [ ; This backs up the blog on a remote site so you don't lose them. ; The remote site should CGI with blog.r?back=n where n the start. ; This can easily be done with a few lines of REBOL for backup. validate-user if not abort [ ; (TGD) ; system/options/binary-base: 64 start: to-integer start out: copy [] foreach file sort load blog-dir [ if (to-integer file) >= start [ repend out [mold file compress read join blog-dir file] ] ] print out abort: true ; (TGD) ; quit ] ] rebuild-blogs: does [ ; Rebuild all cached HTML blog pages. To run this, browse ; with a URL like: http://.../cgi-bin/blog.r?rebuild=0 validate-user if all [not abort blog-root] [ ; (TGD) ; foreach file sort load blog-dir [ clear html print ["Building:" file
] show-blog/build file ] build-rss-feed print "Done" abort: true ; (TGD) ; quit ] ] save-comment: func [file name msg] [ write/append join cmts-dir file repend mold compose [ date (now) name (name) ip (remote-ip) text (msg) ] [newline newline] ] load-comment: func [blog] [ blog/comments: attempt [load/all join cmts-dir blog/file] ] note-comment: func [file sum] [ write/append cmts-log reform [file now sum remote-ip newline] ] load-comment-log: has [log list str] [ log: attempt [load cmts-log] if not log [recent-comments: "" exit] log: head reverse log list: make block! 10 foreach [ip hash time file] log [ if greater? length? list 9 [break] if not find list file [repend list [file time]] ] recent-comments: make string! 100 foreach [file time] list [ file: file-num file repend recent-comments [{} file " "] ] ] abuse?: func [rip sum text /local log tim count] [ count: 0 while [text: find/tail text "http://"] [count: count + 1] if count > 3 [return true] log: attempt [load cmts-log] if log [ tim: now count: 0 log: head reverse log foreach [ip hash time file] log [ if hash = sum [return true] if all [ rip = ip ; (TGD) ; (difference tim time) < 24:00 ; doesn´t work on REBOL/View 1.2.1.1.1 (seconds tim time) < 86400 ; (TGD) ; using Serve-It! seconds func instead ; (TGD) ; (count: count + 1) > 20 (count: count + 1) > comment-max ; (TGD) ; comment spammer ][ return true ] ] ] ] ;-- Blog Page Formatters ----------------------------------------------------- title-blog: func [blog] [ ; Generates a blog title line: reform [blog/date/date "-" blog/title] ] link-blog: func [value text] [ ; Generates an HTML hyper link: rejoin [ {} joins text ] ] blog-line: func [blog] [ ; Generates a full blog summary line: to-string reduce [newline ] ] format-text: func [text] [ ; Formats text for output: either exists? makedoc-script [ ; Use the Makedoc2 text-to-html formatter: if not find text "^/^/###" [text: append copy text "^/^/###"] do/args makedoc-script 'load-only text: scan-doc/options text [no-title] second gen-html/options text [no-title no-toc no-nums no-indent no-template old-tags] ][ replace/all copy text "^/^/" "^/ blog/date/date " - " link-blog blog/file blog/title " [" blog/file "] " optional exists? join cmts-dir blog/file [ make-comment-link/short blog ] " ] ] make-comment-link: func [blog /short] [ to-string reduce [ {} either blog/comments [length? blog/comments]["Post "] pick [{ Comments}{ Cmts}] not short ] ] emit-comment-link: func [blog] [ emit [
make-comment-link blog
] ] emit-comment-form: func [file name message /post /local frm][ init-filter-tags frm: joins bind html-comment-form 'file replace frm "$name" name replace frm "$msg" message replace frm "$more" optional post [button-for-post] emit frm ] format-msg: func [str] [ replace/all copy str "^/^/" "^/" ] emit-comments: func [blog /local n] [ emit {} if block? blog/comments [ emit {
Comments:
} n: true foreach cmt blog/comments [ emit [
] emit {either cmt/name = author [ ] ] emit][ ] limit 24 cmt/name either n: not n [
cmt/date/date " " cmt/date/time][ ] newline format-msg filter-tags cmt/text Post a Comment:
} emit-comment-form blog/file "" "" ] preview-comment: func [file name message] [ message: filter-tags message emit [ {
Verify Your Comment:
} {Please check that your comment is correct. It cannot be changed once it is posted.} {
}
{limit 24 name
now/date " " now/timenewline format-msg message Make Corrections and/or Post It:
} ] emit-comment-form/post file name message ] show-blog: func [file /build /local blog date] [ ; Show a single blog page. If /build is set, then only build it (not show it). ; If /build is not set, then show the page (with comments). if integer? file [file: file-num file] blog: load-blog file ; (TGD) ; if not blog [show-error ["Blog " file " was not found"]] either not blog [show-error ["Blog " file " was not found"]] [ ; (TGD) ; date: blog/date emit bind html-blog-boiler 'blog emit format-text blog/text emit-comment-link blog show-page/build blog/title file emit-comments blog if not build [show-page join "Comments on: " blog/title file] ] ; (TGD) ; ] show-main: has [n files blogs blog date] [ ; Show the main blog page: date: now load-comment-log emit bind html-main-boiler 'date files: sort/reverse load blog-dir blogs: copy [] emit ["Recent Articles:"
] foreach file files [ if blog: load-blog file [ append blogs blog emit blog-line blog if (length? blogs) > max-links [break] ] ] emit [ {
n: 1 foreach blog blogs [ if n > max-blogs [break] emit [} ] emit Contents } {- Index of all articles. title-blog blog " [" link-blog blog/file blog/file "]"
] emit format-text blog/text emit-comment-link blog n: n + 1 ] emit [ {View index of all articles...} ] show-page/main title/main-page ] show-index: has [blog] [ ; Show the blog index page: emit [ {
] emitforeach file sort/reverse load blog-dir [ if blog: load-blog file [emit blog-line blog] ] emit
show-page title/index-page ] show-search: func [text /local rank list blog] [ ; Show the results of a blog search, listed by search-hit rank: text: parse text none list: copy [] foreach file sort/reverse load blog-dir [ if blog: load-blog file [ rank: find-blog blog text if rank > 0 [repend list [rank blog]] ] ] sort/reverse/skip list 2 emit [ "The search found " (length? list) / 2 " blogs (listed by relevance):"] emit
foreach [rank blog] list [emit blog-line blog] emit
show-page title/search-page ] show-edit: func [file /blog] [ ; Show the blog edit form: validate-user if not abort [ ; (TGD) ; either blog: load-blog file [ emit-edit file blog/date blog/title safe-html blog/text show-page ["Edit blog " file ":"] ][ emit-edit 0 now "" "" show-page "Submit a new blog:" ] ] ; (TGD) ; ] show-reply: func [blog] [ ; Show the reply form. Note that the reply processing ; script is not part of this blog system. if blog = "0" [blog: ""] emit-reply reform ["Reply to blog" blog] show-page title/feedback-page ] make-links: func [blk /locals out] [ ; (TGD) ; ; Link to other sites, blogs ... ; (TGD) ; out: make string! 30 ; (TGD) ; foreach [URI txt] blk [ ; (TGD) ; repend out [{
} txt {}] ; (TGD) ; ] ; (TGD) ; out ; (TGD) ; ] ; (TGD) ; make-blog-links: func [file /locals spot out] [ ; Link to prior and next blogs in sequence: out: make string! 30 spot: find sort load blog-dir to-file file if not spot [return ""] if not head? spot [ file: spot/-1 repend out [" || " link-blog file ["Prior Article [" file "]"]] ] if file: spot/2 [ repend out [" || " link-blog file ["Next Article [" file "]"]] ] out ] emit-edit: func [file date title text] [ emit bind html-edit-form 'file ] emit-reply: func [subject] [ emit bind html-reply-form 'subject ] show-source: has [val] [ ; Source code archive emit [{Powered By REBOL
This blogger is powered entirely by REBOL/} system/product { version } system/version ; TGD ; The source code is only } round (size? %blog.r) / 1024 { KB. {. The source code is only } to integer! add 0.5 (size? %blog.r) / 1024 { KB.
View } {} title/main-page { as an example blog.
}
]
foreach word next first system/script/header [
if val: system/script/header/:word [
emit [word ": " val newline]
]
html: detab html
]
emit [{
To run the REBOL blogger, you will need to grab a copy of REBOL/Core from the REBOL.com web site. It is small, fast, does not require installation, and is free for all uses.} ] show-page "Blogger Source Code" ] ;-- RSS Feed (optional) ------------------------------------------------------ build-rss-feed: func [ "Build an RSS feed file for most recent blogs" /local files out blog content ][ if any [not rss-file not exists? rss-file] [exit] ; (TGD) ; files: sort/reverse load blog-dir clear at files max-links out: compose/deep [ channel [ title (title/main-page) link (blog-url) description (meta-description) language "en-us" copyright (copyright) generator "REBOL Messaging Language" ] ] foreach file files [ if blog: load-blog file [ content: load/markup either full-rss [ blog/text ][ trim/lines copy/part blog/text any [ find blog/text "^/^/" tail blog/text ] ] remove-each tag content [tag? tag] content: to-string content append out compose/deep [ item [ title (blog/title) link (join blog-site [blog-path file ".html"]) author (joins [author " <" author-email ">"]) pubdate (blog/date) description (content) ] ] ] ] do %emit-rss.r if blog-root [ write blog-root/:rss-file emit-rss out ] ] ;-- CGI Command Handler ------------------------------------------------------ read-cgi: func [ "Read CGI data. Return data as string or NONE." /limit size "Limit to this number of bytes" /local data buffer ][ if none? limit [size: 300000] switch cgi-obj/request-method [ "POST" [data: system/script/args] ; (TGD) ; Serve-It! sends POST-data via system/script/args to the CGI-script ; (TGD) ; data: make string! 1020 ; (TGD) ; buffer: make string! 16380 ; (TGD) ; while [positive? read-io system/ports/input buffer 16380][ ; (TGD) ; append data buffer ; (TGD) ; clear buffer ; (TGD) ; if (length? data) > size [ ; (TGD) ; print ["aborted - posting is too long:" length? data "limit:" size] ; (TGD) ; quit ; (TGD) ; ] ; (TGD) ; ] ; (TGD) ; ] "GET" [data: cgi-obj/query-string] ] any [data ""] ] ; Possible fields returned by CGI: cgi-fields: context [ view: find: edit: save: date: title: text: reply: index: none ] if not blog-root [blog-path: none] blog-count: 0 ; general blog page hit counter do-cgi: has [cgi] [ ; Main CGI command handler. ; (It's getting to be time to rewrite it.) blog-count: 1 + any [attempt [load blog-counter] 0] save blog-counter blog-count ; (TGD) ; cgi: construct/with decode-cgi read-cgi cgi-fields cgi: make cgi-fields decode-cgi read-cgi ; (TGD) ; if all [not abort in cgi 'get-source] [ ; (TGD) ; print compress read second split-path blog-cgi ; (TGD) ; clear ct ; set Serve-It! content-type ; (TGD) ; insert ct "text/plain" ; callback to appropriate type ; (TGD) ; ; (TGD) ; print read %blog.r ; use REBOL read url to save it ; (TGD) ; abort: true ; (TGD) ; ] ; (TGD) ; if all [not abort found? cgi/view] [show-blog to-integer cgi/view] ; (TGD) ; if all [not abort found? cgi/index] [show-index] ; (TGD) ; if all [not abort found? cgi/reply] [show-reply cgi/reply] ; (TGD) ; if all [not abort found? cgi/edit] [show-edit cgi/edit] ; (TGD) ; if all [not abort found? cgi/find] [show-search cgi/find] ; (TGD) ; if all [not abort found? cgi/save] [ ; (TGD) ; show-blog save-blog cgi/save cgi/date cgi/title cgi/text ; (TGD) ; ] ; (TGD) ; if all [not abort in cgi 'cmt] [ ; (TGD) ; if not in cgi 'cancel [ if any [ empty? cgi/cmt empty? cgi/name empty? cgi/text ][ show-error "Missing field in form. Go back and try again." ] if all [not abort (length? cgi/text) > 4000] [ ; (TGD) ; show-error "Message is too long. Go back and trim it down." ] if all [not abort ; (TGD) ; any [ ; Qualify the comment id: find cgi/cmt #"/" not attempt [to-integer cgi/cmt] not exists? join blog-dir cgi/cmt ] ] [ show-error "Invalid comment submission" ] if all [not abort find cgi/name "<"] [ ; (TGD) ; show-error "Tags not allowed in name field. Go back and change it." ] if all [ not abort ; (TGD) ; find-any cgi/name comment-name-restrict admin-ip admin-ip <> remote-ip ][ show-error "Restricted name. Go back and use your name." ] if all [not abort find-any cgi/text comment-restrict] [ ; (TGD) ; show-error "Restricted words found in comment." ] ] if all [not abort in cgi 'preview] [ ; (TGD) ; preview-comment cgi/cmt cgi/name cgi/text show-page "Preview" ] if all [not abort in cgi 'post] [ sum: checksum/secure rejoin [cgi/name cgi/text cgi/cmt] either abuse? remote-ip sum cgi/text [ ; (TGD) ; show-error ["Duplicate posting or abuse detected from" remote-ip] ][ save-comment cgi/cmt cgi/name cgi/text note-comment cgi/cmt sum show-blog cgi/cmt ] ] ] if all [not abort in cgi 'back] [backup-blogs cgi/back] ; (TGD) ; if all [not abort in cgi 'rebuild] [rebuild-blogs] ; (TGD) ; if all [not abort in cgi 'source] [show-source] ; (TGD) ; if not abort [show-main ] ; (TGD) ; ] if not exists? blog-dir [make-dir/deep blog-dir] if all [blog-root not exists? blog-root] [make-dir/deep blog-root] if not exists? cmts-dir [make-dir/deep cmts-dir] ;-- Tests ; Uncomment any of the lines below. But, dont' forget to comment it ; back when you upload it back to your server. ;save-blog 2 now/date "Test" "This is a test" ;show-index ;show-main ;backup-blogs 0 ;show-blog %0001 ;show-edit %0001 ;show-search "draw" ;show-source do-cgi ; start it (if no tests are uncommented) ; (TGD) ;halt