cadence/breezewiki
2
4
Fork 4
Code Issues Pull requests 1 Releases Wiki Activity

Compare commits

base: cadence:a57445abcbda2df7d030587111b7eb8155f769e9
Branches Tags
cadence:main
cadence:disable-requests
cadence:early-hints
..
compare: cadence:aea627b27f794c3a219d335f363130f16cdb0791
Branches Tags
cadence:main
cadence:disable-requests
cadence:early-hints

No commits in common. "a57445abcbda2df7d030587111b7eb8155f769e9" and "aea627b27f794c3a219d335f363130f16cdb0791" have entirely different histories.
a57445abcb ... aea627b27f

9 changed files with 323 additions and 397 deletions
Download patch file Download diff file Expand all files Collapse all files

13
archiver/archiver-cli.rkt
View file

@ -35,12 +35,9 @@
(output-lines? #t)])) (output-lines? #t)]))
(define (update-width) (define (update-width)
(when (output-progress?) (when (output-progress?)
(case (system-type 'os) (with-charterm
[(linux) (call-with-values (λ () (charterm-screen-size))
(with-charterm (λ (cols rows) (set! width cols))))))
(call-with-values (λ () (charterm-screen-size))
(λ (cols rows) (set! width cols))))]
[else 100])))
(update-width) (update-width)
;; check ;; check
(when (or (not wikiname) (equal? wikiname "")) (when (or (not wikiname) (equal? wikiname ""))
@ -59,8 +56,8 @@
(define real-width (min (string-length basename) rest)) (define real-width (min (string-length basename) rest))
(define spare-width (- rest real-width)) (define spare-width (- rest real-width))
(define name-display (substring basename 0 real-width)) (define name-display (substring basename 0 real-width))
(printf "\e[2K\r~a~a" prefix name-display) (define whitespace (make-string spare-width #\ ))
(flush-output)])) (printf "~a~a~a\r" prefix name-display whitespace)]))
;; download all stages ;; download all stages
(for ([stage all-stages] (for ([stage all-stages]
[i (in-naturals 1)]) [i (in-naturals 1)])

3
archiver/archiver-database.rkt
View file

@ -48,8 +48,7 @@
((query-exec slc* "alter table wiki add column sitename TEXT") ((query-exec slc* "alter table wiki add column sitename TEXT")
(query-exec slc* "alter table wiki add column basepage TEXT") (query-exec slc* "alter table wiki add column basepage TEXT")
(query-exec slc* "alter table wiki add column license_text TEXT") (query-exec slc* "alter table wiki add column license_text TEXT")
(query-exec slc* "alter table wiki add column license_url TEXT")) (query-exec slc* "alter table wiki add column license_url TEXT"))))
((query-exec slc* "alter table page add column redirect"))))
(let do-migrate-step () (let do-migrate-step ()
(when (database-version . < . (length migrations)) (when (database-version . < . (length migrations))

138
archiver/archiver.rkt
View file

@ -1,6 +1,5 @@
#lang racket/base #lang racket/base
(require racket/file (require racket/file
racket/format
racket/function racket/function
racket/list racket/list
racket/path racket/path
@ -44,18 +43,10 @@
wikiname wikiname
(params->query '(("action" . "query") (params->query '(("action" . "query")
("meta" . "siteinfo") ("meta" . "siteinfo")
("siprop" . "general|rightsinfo|statistics|namespaces") ("siprop" . "general|rightsinfo|statistics")
("format" . "json") ("format" . "json")
("formatversion" . "2"))))) ("formatversion" . "2")))))
(define data (response-json (get dest-url))) (define data (response-json (get dest-url)))
(define content-nss
(sort
(for/list ([(k v) (in-hash (jp "/query/namespaces" data))]
#:do [(define id (hash-ref v 'id))]
#:when (and (id . < . 2900) ; exclude maps namespace
(hash-ref v 'content))) ; exclude non-content and talk namespaces
id)
<))
(define exists? (query-maybe-value* "select progress from wiki where wikiname = ?" wikiname)) (define exists? (query-maybe-value* "select progress from wiki where wikiname = ?" wikiname))
(if (and exists? (not (sql-null? exists?))) (if (and exists? (not (sql-null? exists?)))
(query-exec* "update wiki set sitename = ?, basepage = ?, license_text = ?, license_url = ? where wikiname = ?" (query-exec* "update wiki set sitename = ?, basepage = ?, license_text = ?, license_url = ? where wikiname = ?"
@ -70,8 +61,7 @@
(second (regexp-match #rx"/wiki/(.*)" (jp "/query/general/base" data))) (second (regexp-match #rx"/wiki/(.*)" (jp "/query/general/base" data)))
(jp "/query/rightsinfo/text" data) (jp "/query/rightsinfo/text" data)
(jp "/query/rightsinfo/url" data))) (jp "/query/rightsinfo/url" data)))
(values (jp "/query/statistics/articles" data) (jp "/query/statistics/articles" data))
content-nss))
(define (check-style-for-images wikiname path) (define (check-style-for-images wikiname path)
@ -141,57 +131,48 @@
;; done yet? ;; done yet?
(unless (and (real? wiki-progress) (wiki-progress . >= . 1)) (unless (and (real? wiki-progress) (wiki-progress . >= . 1))
;; Count total pages ;; Count total pages
(define-values (num-pages namespaces) (insert-wiki-entry wikiname)) (define num-pages (insert-wiki-entry wikiname))
;; Download the entire index of pages ;; Download the entire index of pages
(for*/fold ([total 0]) (define basenames
([namespace namespaces] (let loop ([path-with-namefrom "/wiki/Local_Sitemap"]
[redir-filter '("nonredirects" "redirects")]) [basenames-previous-pages null])
(let loop ([apcontinue ""] ;; Download the current index page
[basenames null]) (define url (format "https://~a.fandom.com~a" wikiname path-with-namefrom))
(cond (define r (get url))
[apcontinue ;; Metadata from this page (the link to the next page)
(define url (format "https://~a.fandom.com/api.php?~a" (define page (html->xexp (bytes->string/utf-8 (response-body r))))
wikiname (define link-namefrom
(params->query `(("action" . "query") ((query-selector (λ (t a c x) (and (eq? t 'a)
("list" . "allpages") (pair? x)
("apnamespace" . ,(~a namespace)) (string-contains? (car x) "Next page")
("apfilterredir" . ,redir-filter) (let ([href (get-attribute 'href a)] )
("aplimit" . "500") (and href (string-contains? href "/wiki/Local_Sitemap")))))
("apcontinue" . ,apcontinue) page #:include-text? #t)))
("format" . "json") ;; Content from this page
("formatversion" . "2"))))) (define basenames-this-page
;; Download the current listing page (for/list ([link (in-producer
(define res (get url)) (query-selector
(define json (response-json res)) (λ (t a c) (eq? t 'a))
;; Content from this page ((query-selector (λ (t a c) (has-class? "mw-allpages-chunk" a)) page)))
(define current-basenames #f)])
(for/list ([page (jp "/query/allpages" json)]) (local-encoded-url->basename (get-attribute 'href (bits->attributes link)))))
(title->basename (jp "/title" page)))) ;; Call the progress callback
(when ((length current-basenames) . > . 0) (define all-basenames (append basenames-previous-pages basenames-this-page))
;; Report (callback (length all-basenames) num-pages (last all-basenames))
(if (equal? redir-filter "nonredirects") ;; Recurse to download from the next page
(callback (+ (length basenames) (length current-basenames) total) num-pages (last current-basenames)) (if link-namefrom
(callback total num-pages (last current-basenames)))) (loop (get-attribute 'href (bits->attributes link-namefrom)) all-basenames)
;; Loop all-basenames)))
(loop (jp "/continue/apcontinue" json #f) (append basenames current-basenames))] ;; Save those pages into the database
[else ;; SQLite can have a maximum of 32766 parameters in a single query
;; All done with this (loop)! Save those pages into the database (for ([slice (in-slice 32760 basenames)])
;; SQLite can have a maximum of 32766 parameters in a single query (define query-template (string-join (make-list (length slice) "(?1, ?, 0)") ", " #:before-first "insert or ignore into page (wikiname, basename, progress) values "))
(begin0 (call-with-transaction
;; next for*/fold (get-slc)
(if (equal? redir-filter "nonredirects") (λ ()
(+ (length basenames) total) (apply query-exec* query-template wikiname slice)
total) ; redirects don't count for the site statistics total ;; Record that we have the complete list of pages
(call-with-transaction (query-exec* "update wiki set progress = 1 where wikiname = ?" wikiname))))))
(get-slc)
(λ ()
(for ([slice (in-slice 32760 basenames)])
(define query-template
(string-join #:before-first "insert or ignore into page (wikiname, redirect, basename, progress) values "
(make-list (length slice) "(?1, ?2, ?, 0)") ", "))
(apply query-exec* query-template wikiname (if (equal? redir-filter "redirects") 1 sql-null) slice)))))])))
;; Record that we have the complete list of pages
(query-exec* "update wiki set progress = 1 where wikiname = ?" wikiname)))
;; 2. Download each page via API and: ;; 2. Download each page via API and:
@ -202,7 +183,7 @@
(define save-dir (build-path archive-root wikiname)) (define save-dir (build-path archive-root wikiname))
(make-directory* save-dir) (make-directory* save-dir)
;; gather list of basenames to download (that aren't yet complete) ;; gather list of basenames to download (that aren't yet complete)
(define basenames (query-list* "select basename from page where wikiname = ? and progress < ? and redirect is null" (define basenames (query-list* "select basename from page where wikiname = ? and progress < ?"
wikiname max-page-progress)) wikiname max-page-progress))
;; counter of complete/incomplete basenames ;; counter of complete/incomplete basenames
(define already-done-count (define already-done-count
@ -241,41 +222,10 @@
(query-exec* "update page set progress = 1 where wikiname = ? and basename = ?" (query-exec* "update page set progress = 1 where wikiname = ? and basename = ?"
wikiname basename) wikiname basename)
(callback i total-count basename)) (callback i total-count basename))
;; save redirects as well
(save-redirects wikiname callback (+ already-done-count (length basenames)) total-count)
;; saved all pages, register that fact in the database ;; saved all pages, register that fact in the database
(query-exec* "update wiki set progress = 2 where wikiname = ?" wikiname)) (query-exec* "update wiki set progress = 2 where wikiname = ?" wikiname))
;; 2.5. Download each redirect-target via API and save mapping in database
(define (save-redirects wikiname callback already-done-count total-count)
(define basenames (query-list* "select basename from page where wikiname = ? and progress < ? and redirect = 1"
wikiname max-page-progress))
;; loop through basenames, in slices of 50 (MediaWiki API max per request), and download
(for ([basename basenames]
[i (in-naturals (add1 already-done-count))])
(define dest-url
(format "https://~a.fandom.com/api.php?~a"
wikiname
(params->query `(("action" . "query")
("prop" . "links")
("titles" . ,(basename->name-for-query basename))
("format" . "json")
("formatversion" . "2")))))
(define res (get dest-url))
(define json (response-json res))
(define dest-title (jp "/query/pages/0/links/0/title" json #f))
(callback i total-count basename)
(cond
[dest-title
;; store it
(define dest-basename (title->basename dest-title))
(query-exec* "update page set progress = 1, redirect = ? where wikiname = ? and basename = ?" dest-basename wikiname basename)]
[else
;; the page just doesn't exist
(query-exec* "delete from page where wikiname = ? and basename = ?" wikiname basename)])))
;; 3. Download CSS and: ;; 3. Download CSS and:
;; * Save CSS to file ;; * Save CSS to file
;; * Record style images to database ;; * Record style images to database

402
archiver/fts.rkt
View file

@ -1,200 +1,202 @@
#lang cli #lang racket
(require (for-syntax racket/base)) (require racket/function
(require racket/format racket/future
racket/function racket/match
racket/future racket/path
racket/match racket/promise
racket/path racket/port
racket/promise racket/string
racket/port file/gunzip
racket/runtime-path db
racket/string db/unsafe/sqlite3
file/gunzip net/http-easy
db json
db/unsafe/sqlite3 json-pointer
net/http-easy "../lib/html-parsing/main.rkt"
json "../lib/xexpr-utils.rkt"
json-pointer "../lib/tree-updater.rkt")
"../lib/html-parsing/main.rkt"
"../lib/xexpr-utils.rkt" (define-syntax (seq stx)
"../lib/tree-updater.rkt") (syntax-case stx ()
[(_ body ...)
(flag (read-from-cache?) #`(for ([op (list (lambda () body) ...)]
("-c" "--read-from-cache" "read from last run cache instead of rebuilding documents") [i (in-naturals)])
(read-from-cache? #t)) (define res (op))
(when (>= (response-status-code res) 400)
(define-runtime-path storage-path "../storage/archive") (error 'seq "op #~a: status code was ~a: ~v" i (response-status-code res) (response-json res)))
(define taskuid (json-pointer-value "/taskUid" (response-json res)))
;; *************************************************************************************************** (for/or ([ticks (in-naturals)]
;; Progress bar display [res2 (in-producer (lambda () (get (format "http://localhost:7700/tasks/~a" taskuid))))])
;; *************************************************************************************************** (define status (json-pointer-value "/status" (response-json res2)))
(case status
(struct progress^ (n max title) #:transparent) [("enqueued" "processing")
(sleep 1)
(define (make-m-s seconds) #f]
(define-values (eta-m eta-s) (quotient/remainder seconds 60)) [("succeeded")
(format "~a:~a" eta-m (~a eta-s #:width 2 #:align 'right #:pad-string "0"))) (printf "op #~a: ~a (~a ticks)~n" i status ticks)
#t]
(define (make-progress get-p [history-size 20]) [else
(define update-sleep 1) (error 'seq "op #~a: task status was ~a: ~v" i status res2)])))]))
(define name-width 30)
(define max-width 105) (define (class-has? attributes substrs)
(define history (make-vector history-size 0)) (define cl (or (get-attribute 'class attributes) ""))
(define history-pointer 0) (ormap (λ (substr) (string-contains? cl substr)) substrs))
(define elapsed 0)
(define (report-progress) (define (updater element element-type attributes children)
(define p (get-p)) (cond
(define history-cycle (vector-ref history history-pointer)) [(class-has? attributes '("collapsed" "selflink" "label" "toc" "editsection" "reviews"))
(vector-set! history history-pointer (progress^-n p)) (list 'div '() '())]
(set! history-pointer (modulo (add1 history-pointer) history-size)) [#t
(set! elapsed (add1 elapsed)) (list element-type attributes children)]))
(define-values (eta-display diff-per-second)
(cond (define slc (sqlite3-connect #:database "../storage/fts-separate.db"))
[((progress^-n p) . >= . (progress^-max p)) (values (format "~a **" (make-m-s elapsed)) (format "** ~a" (quotient (progress^-max p) (max elapsed 1))))] (sqlite3-load-extension slc "fts5")
[(= history-cycle 0) (values "-:--" "--")]
[else (define diff-per-second (/ (- (progress^-n p) history-cycle) (* history-size update-sleep))) (define (writer tables-mode? page)
(define eta-total (define (writer-inner page)
(if (diff-per-second . > . 0) (for ([bit page])
(floor (round (/ (- (progress^-max p) (progress^-n p)) diff-per-second))) (cond
0)) [(and tables-mode? (pair? bit) (memq (car bit) '(h1 h2 h3 p blockquote q))) (void)]
(values (make-m-s eta-total) [(and (not tables-mode?) (pair? bit) (memq (car bit) '(ul ol dl table))) (void)]
(round diff-per-second))])) [(memq bit '(div p li td dd dt br)) (displayln "")]
(define left (format "~a/~a ~a/s ~a ~a%" [(symbol? bit) (void)]
(~a (progress^-n p) #:width (string-length (~a (progress^-max p))) #:align 'right #:pad-string " ") [(and (pair? bit) (eq? (car bit) '*COMMENT*)) (void)]
(progress^-max p) [(and (pair? bit) (eq? (car bit) '@)) (void)]
diff-per-second [(pair? bit) (writer-inner bit)]
eta-display [(string? bit) (display bit)])))
(floor (* 100 (/ (progress^-n p) (progress^-max p)))))) (writer-inner page))
(define name-display (~a (progress^-title p) #:max-width name-width #:limit-marker "..."))
(define remaining-space (- max-width name-width (string-length left) 2)) (define (write-and-post-process tables-mode? page)
(define bar-width (define text (with-output-to-string (λ () (writer tables-mode? page))))
(floor (* (sub1 remaining-space) ;; (define text-no-numbers (regexp-replace* #px"(?:-|[+$£€¥] *)?[0-9,.]{2,}%?\\s*" text ""))
(/ (progress^-n p) (progress^-max p))))) (define shrink-text (regexp-replace* #px"([ \t]*\r?\n+)+" text "\n"))
(define bar (string-append (make-string bar-width #\=) shrink-text)
">"
(make-string (- remaining-space bar-width) #\ ))) (define wikiname "bloons")
(printf "\e[2K\r~a~a~a" left bar name-display) (define tablename (format "page_~a" wikiname))
(flush-output))
(define (report-progress-loop) (define ((extract f)) ; f - filename
(sleep update-sleep) (with-handlers
(report-progress) ([exn:fail? (λ (err) (println f) (raise err))])
(report-progress-loop)) (define j
(define t (thread report-progress-loop)) (case (path-get-extension f)
(define (quit) [(#".json")
(kill-thread t) (with-input-from-file f (λ () (read-json)))]
(report-progress) [(#".gz")
(displayln "")) (define-values (in out) (make-pipe))
quit) (with-input-from-file f (λ () (gunzip-through-ports (current-input-port) out)))
(read-json in)]
;; *************************************************************************************************** [else #f]))
;; Page text extractor (define title (json-pointer-value "/parse/title" j))
;; *************************************************************************************************** (define pageid (json-pointer-value "/parse/pageid" j))
(define page-html (preprocess-html-wiki (json-pointer-value "/parse/text" j)))
(define (class-has? attributes substrs) (define page (update-tree updater (html->xexp page-html)))
(define cl (or (get-attribute 'class attributes) "")) (define body (write-and-post-process #f page))
(ormap (λ (substr) (string-contains? cl substr)) substrs)) (define table (write-and-post-process #t page))
(values title body table pageid)))
(define (updater element element-type attributes children)
(cond (define results
[(class-has? attributes '("collapsed" "selflink" "label" "toc" "editsection" "reviews")) (for/list ([f (directory-list (format "../storage/archive/~a" wikiname) #:build? #t)]
(list 'div '() '())] #:when (member (path-get-extension f) '(#".json" #".gz")))
[#t (extract f)))
(list element-type attributes children)]))
;; ***************************************************************************************************
(define (writer tables-mode? page) ;; TESTING WRITER
(define (writer-inner page) ;; ***************************************************************************************************
(for ([bit page]) #;(for/first ([fut results]
(cond [i (in-naturals 1)]
[(and tables-mode? (pair? bit) (memq (car bit) '(h1 h2 h3 p blockquote q))) (void)] #:when (i . >= . 4859))
[(and (not tables-mode?) (pair? bit) (memq (car bit) '(ul ol dl table))) (void)] (define-values (title body table pageid) (fut))
[(memq bit '(div p li td dd dt br)) (displayln "")] (println title)
[(symbol? bit) (void)] (println body)
[(and (pair? bit) (eq? (car bit) '*COMMENT*)) (void)] (println table))
[(and (pair? bit) (eq? (car bit) '@)) (void)]
[(pair? bit) (writer-inner bit)] (println "inserting...")
[(string? bit) (display bit)])))
(writer-inner page)) ;; ***************************************************************************************************
;; SQLite FTS5
(define (write-and-post-process tables-mode? page) ;; ***************************************************************************************************
(define text (with-output-to-string (λ () (writer tables-mode? page)))) #;(begin
;; (define text-no-numbers (regexp-replace* #px"(?:-|[+$£€¥] *)?[0-9,.]{2,}%?\\s*" text "")) (query-exec slc "begin transaction")
(define shrink-text (regexp-replace* #px"([ \t]*\r?\n+)+" text "\n")) #;(query-exec slc (format "create virtual table \"~a\" using fts5 (title, body, tokenize='porter unicode61')" wikiname))
shrink-text) (time
(for ([fut results]
(define ((extract f)) ; f - filename [i (in-naturals 1)])
(with-handlers (display "-")
([exn:fail? (λ (err) (printf "extract: ~a: ~v~n" f err))]) (when (and (> i 0) (= (modulo i 100) 0))
(define j (println i))
(case (path-get-extension f) (define-values (title shrink-text) (fut))
[(#".json") (query-exec slc (format "insert into \"~a\" (title, body) values (?, ?)" tablename) title shrink-text)))
(with-input-from-file f (λ () (read-json)))]
[(#".gz") (println "running optimize...")
(define-values (in out) (make-pipe)) (query-exec slc (format "insert into \"~a\" (\"~a\") values ('optimize')" tablename tablename))
(with-input-from-file f (λ () (gunzip-through-ports (current-input-port) out)))
(read-json in)] (println "committing...")
[else #f])) (query-exec slc "commit"))
(define title (json-pointer-value "/parse/title" j))
(define pageid (json-pointer-value "/parse/pageid" j)) ;; ***************************************************************************************************
(define page-html (preprocess-html-wiki (json-pointer-value "/parse/text" j))) ;; Solr
(define page (update-tree updater (html->xexp page-html))) ;; ***************************************************************************************************
(define body (write-and-post-process #f page)) (begin
(define table (write-and-post-process #t page)) (define data
(list title body table pageid))) (cond
#;[(file-exists? "cache.rkt")
;; *************************************************************************************************** (println "reading in...")
;; Program, loop, Solr APIs (with-input-from-file "cache.rkt" (λ () (read)))]
;; *************************************************************************************************** [else
(define data
(program (for/list ([fut results]
(start [wikiname "wikiname to download"]) [i (in-naturals 1)])
(display "-")
(define results (when (and (> i 0) (= (modulo i 100) 0))
(for/list ([f (directory-list (build-path storage-path wikiname) #:build? #t)] (println i))
#:when (member (path-get-extension f) '(#".gz"))) (define-values (title body table pageid) (fut))
(extract f))) (define len (string-length body))
`#hasheq((id . ,(number->string pageid))
(define data (title . ,title)
(cond (body . ,body)
[(and (read-from-cache?) (file-exists? "cache.rkt")) (table . ,table)
(displayln "Reading in...") (len . ,len))))
(with-input-from-file "cache.rkt" (λ () (read)))]
[else (println "writing out...")
(define x (box (progress^ 0 1 "..."))) (with-output-to-file "cache.rkt" (λ () (write data)) #:exists 'truncate/replace)
(define quit (make-progress (λ () (unbox x)))) data]))
(define data
(for/list ([fut results] (println "posting...")
[i (in-naturals 1)] (define res
#:do [(define page (fut))] (post (format "http://localhost:8983/solr/~a/update?commit=true" wikiname)
#:when (not (void? page))) #:json data)))
(match-define (list title body table pageid) page)
(define len (string-length body)) ;; ***************************************************************************************************
(set-box! x (progress^ i (length results) title)) ;; Meilisearch
`#hasheq((id . ,(number->string pageid)) ;; ***************************************************************************************************
(title . ,title) #;(begin
(body . ,body) (seq
(table . ,table) (put (format "http://localhost:7700/indexes/~a/settings/searchable-attributes" wikiname)
(len . ,len)))) #:json '("title" "body"))
(quit) (put (format "http://localhost:7700/indexes/~a/settings/ranking-rules" wikiname)
#:json '("words" "typo" #;"proximity" "attribute" "sort" "exactness" #;"len:desc"))
(display "Writing out... ") (call-with-input-file "stop-words.json"
(flush-output) (λ (in)
(with-output-to-file "cache.rkt" (λ () (write data)) #:exists 'truncate/replace) (put (format "http://localhost:7700/indexes/~a/settings/stop-words" wikiname)
data])) #:headers '#hasheq((Content-Type . "application/json"))
#:data in))))
(display "Converting... ") (define data
(flush-output) (for/list ([fut results]
(define ser (jsexpr->bytes data)) [i (in-naturals 1)])
(define ser-port (open-input-bytes ser)) (display "-")
(define quit (make-progress (λ () (progress^ (ceiling (/ (file-position ser-port) 64 1024)) (when (and (> i 0) (= (modulo i 100) 0))
(ceiling (/ (bytes-length ser) 64 1024)) (println i))
"Posting...")) (define-values (title body pageid) (fut))
2)) (define len (string-length body))
(define res `#hasheq((id . ,pageid)
(post (format "http://localhost:8983/solr/~a/update?commit=true" wikiname) (title . ,title)
#:data ser-port (body . ,body)
#:headers '#hasheq((Content-Type . "application/json")) (len . ,len))))
#:timeouts (make-timeout-config #:lease 5 #:connect 5 #:request 300))) (define res
(quit) (post (format "http://localhost:7700/indexes/~a/documents" wikiname)
(displayln (response-status-line res))) #:json data))
(seq res)
(run start) (println (response-json res)))
(disconnect slc)

7
lib/archive-file-mappings.rkt
View file

@ -7,7 +7,6 @@
local-encoded-url->segments local-encoded-url->segments
url-segments->basename url-segments->basename
local-encoded-url->basename local-encoded-url->basename
title->basename
basename->name-for-query basename->name-for-query
url-segments->guess-title) url-segments->guess-title)
@ -22,12 +21,6 @@
(define (local-encoded-url->basename str) ; '("wiki" "Page_title"), no extension or dir prefix (define (local-encoded-url->basename str) ; '("wiki" "Page_title"), no extension or dir prefix
(url-segments->basename (local-encoded-url->segments str))) (url-segments->basename (local-encoded-url->segments str)))
(define (title->basename title) ; "Page title/Strategies" -> "Page_title#Strategies" filename encoded, no extension or dir prefi
(define elements (string-split (string-replace title " " "_") "/"))
(define extra-encoded (map (λ (s) (bytes->string/latin-1 (percent-encode s filename-set #f))) elements))
(define basic-filename (string-join extra-encoded "#"))
basic-filename)
(define (basename->name-for-query str) (define (basename->name-for-query str)
(uri-decode (regexp-replace* #rx"#" str "/"))) (uri-decode (regexp-replace* #rx"#" str "/")))

6
src/extwiki-data.rkt
View file

@ -377,7 +377,7 @@
'("runescape") 'default '("runescape") 'default
'RuneScape 'RuneScape
"RuneScape Wiki" "RuneScape Wiki"
"https://runescape.wiki/w/Main_Page" "https://runescape.wiki/"
"https://runescape.wiki/images/Wiki.png" "https://runescape.wiki/images/Wiki.png"
(λ (props) (λ (props)
`((p "The RuneScape Wiki was founded on April 8, 2005. In October 2018, the wiki left Fandom (then Wikia), citing their apathy towards the wiki and excessive advertisements.")))) `((p "The RuneScape Wiki was founded on April 8, 2005. In October 2018, the wiki left Fandom (then Wikia), citing their apathy towards the wiki and excessive advertisements."))))
@ -386,7 +386,7 @@
'("oldschoolrunescape") 'default '("oldschoolrunescape") 'default
'RuneScape 'RuneScape
"Old School RuneScape Wiki" "Old School RuneScape Wiki"
"https://oldschool.runescape.wiki/w/Main_Page" "https://oldschool.runescape.wiki/"
"https://oldschool.runescape.wiki/images/Wiki.png" "https://oldschool.runescape.wiki/images/Wiki.png"
(λ (props) (λ (props)
`((p "The Old School RuneScape Wiki was founded on February 14, 2013. In October 2018, the RuneScape Wiki left Fandom (then Wikia), citing their apathy towards the wiki and excessive advertisements, with the Old School RuneScape Wiki following suit.")))) `((p "The Old School RuneScape Wiki was founded on February 14, 2013. In October 2018, the RuneScape Wiki left Fandom (then Wikia), citing their apathy towards the wiki and excessive advertisements, with the Old School RuneScape Wiki following suit."))))
@ -395,7 +395,7 @@
'("runescapeclassic") 'default '("runescapeclassic") 'default
'RuneScape 'RuneScape
"RuneScape Classic Wiki" "RuneScape Classic Wiki"
"https://classic.runescape.wiki/w/Main_Page" "https://classic.runescape.wiki/"
"https://classic.runescape.wiki/images/Wiki.png" "https://classic.runescape.wiki/images/Wiki.png"
(λ (props) (λ (props)
`((p "The Old School RuneScape Wiki was founded on April 19, 2009. In October 2018, the RuneScape Wiki left Fandom (then Wikia), citing their apathy towards the wiki and excessive advertisements, with the RuneScape Classic Wiki following suit.")))) `((p "The Old School RuneScape Wiki was founded on April 19, 2009. In October 2018, the RuneScape Wiki left Fandom (then Wikia), citing their apathy towards the wiki and excessive advertisements, with the RuneScape Classic Wiki following suit."))))

2
src/page-global-search.rkt
View file

@ -19,7 +19,7 @@
[(not wikiname) [(not wikiname)
(response/output (response/output
#:code 400 #:code 400
#:mime-type #"text/plain" #:mime-type "text/plain"
(λ (out) (λ (out)
(displayln "Requires wikiname and q parameters." out)))] (displayln "Requires wikiname and q parameters." out)))]
[(or (not q) (equal? q "")) [(or (not q) (equal? q ""))

3
src/page-search.rkt
View file

@ -53,8 +53,7 @@
;; grab the part after ?q= which is the search terms ;; grab the part after ?q= which is the search terms
(define query (dict-ref params 'q #f)) (define query (dict-ref params 'q #f))
;; figure out which search provider we're going to use ;; figure out which search provider we're going to use
(define search-provider (hash-ref search-providers (config-get 'feature_offline::search) (define search-provider (hash-ref search-providers (config-get 'feature_offline::search)))
(λ () (error 'search-provider "unknown search provider configured"))))
;; external special:search url to link at the bottom of the page as the upstream source ;; external special:search url to link at the bottom of the page as the upstream source
(define external-search-url (define external-search-url

146
src/page-wiki-offline.rkt
View file

@ -20,7 +20,6 @@
web-server/dispatchers/dispatch web-server/dispatchers/dispatch
; my libs ; my libs
"application-globals.rkt" "application-globals.rkt"
"../archiver/archiver-database.rkt"
"config.rkt" "config.rkt"
"data.rkt" "data.rkt"
"log.rkt" "log.rkt"
@ -41,9 +40,6 @@
(define path-archive (anytime-path ".." "storage/archive")) (define path-archive (anytime-path ".." "storage/archive"))
(when (config-true? 'feature_offline::only)
(void (get-slc)))
(define (page-wiki-offline req) (define (page-wiki-offline req)
(response-handler (response-handler
(define wikiname (path/param-path (first (url-path (request-uri req))))) (define wikiname (path/param-path (first (url-path (request-uri req)))))
@ -68,94 +64,84 @@
[else (error 'archive-format "unknown archive format configured")])) [else (error 'archive-format "unknown archive format configured")]))
(define fs-path (build-path path-archive wikiname (format (car archive-format) maybe-hashed-basename))) (define fs-path (build-path path-archive wikiname (format (car archive-format) maybe-hashed-basename)))
(define source-url (format "https://~a.fandom.com/wiki/~a" wikiname (basename->name-for-query basename))) (define source-url (format "https://~a.fandom.com/wiki/~a" wikiname (basename->name-for-query basename)))
(cond/var (cond
[(not (file-exists? fs-path))
[(file-exists? fs-path) (unless (config-true? 'feature_offline::only)
(when (config-true? 'debug) (next-dispatcher))
(printf "using offline mode for ~v~n" fs-path)) (define mirror-path (url->string (request-uri req)))
(response-handler
(define data (with-input-from-file fs-path (cdr archive-format)))
(define article-title (jp "/parse/title" data))
(define original-page (html->xexp (preprocess-html-wiki (jp "/parse/text" data))))
(define page ((query-selector (λ (t a c) (has-class? "mw-parser-output" a)) original-page)))
(define initial-head-data ((head-data-getter wikiname) data))
(define head-data
(case theme
[(light dark)
(struct-copy head-data^ initial-head-data
[body-class (regexp-replace #rx"(theme-fandomdesktop-)(light|dark)"
(head-data^-body-class initial-head-data)
(format "\\1~a" theme))])]
[else initial-head-data]))
(define body (define body
(generate-wiki-page (generate-wiki-page
(update-tree-wiki page wikiname) `(div (@ (class "unsaved-page"))
(style ".unsaved-page a { text-decoration: underline !important }")
(p "breezewiki.com doesn't have this page saved.")
(p "You can see this page by visiting a BreezeWiki mirror:")
(ul
(li (a (@ (href ,(format "https://antifandom.com~a" mirror-path))) "View on antifandom.com"))
(li (a (@ (href ,(format "https://bw.artemislena.eu~a" mirror-path))) "View on artemislena.eu"))
(li (a (@ (href ,source-url)) "or, you can see the original page on Fandom (ugh)")))
(p "If you'd like " ,wikiname ".fandom.com to be added to breezewiki.com, " (a (@ (href "https://lists.sr.ht/~cadence/breezewiki-requests")) "let me know about it!")))
#:req req #:req req
#:source-url source-url #:source-url source-url
#:wikiname wikiname #:wikiname wikiname
#:title article-title #:title (url-segments->guess-title segments)
#:online-styles #f #:online-styles #f
#:head-data head-data
#:siteinfo (siteinfo-fetch wikiname) #:siteinfo (siteinfo-fetch wikiname)
)) ))
(define redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body)))
(define redirect-query-parameter (dict-ref (url-query (request-uri req)) 'redirect "yes"))
(define headers
(build-headers
always-headers
; redirect-query-parameter: only the string "no" is significant:
; https://github.com/Wikia/app/blob/fe60579a53f16816d65dad1644363160a63206a6/includes/Wiki.php#L367
(when (and redirect-msg
(not (equal? redirect-query-parameter "no")))
(let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))]
[value (bytes-append #"0;url=" (string->bytes/utf-8 dest))])
(header #"Refresh" value)))))
(when (config-true? 'debug) (when (config-true? 'debug)
; used for its side effects ; used for its side effects
; convert to string with error checking, error will be raised if xexp is invalid ; convert to string with error checking, error will be raised if xexp is invalid
(xexp->html body)) (xexp->html body))
(response/output (response/output
#:code 200 #:code 200
#:headers headers #:headers always-headers
(λ (out) (λ (out)
(write-html body out))))] (write-html body out)))]
[#t
;; page not found on disk, perhaps it's a redirect? redirects are stored in the database (when (config-true? 'debug)
(var target (query-maybe-value* "select redirect from page where wikiname = ? and basename = ?" wikiname basename)) (printf "using offline mode for ~v~n" fs-path))
[target (response-handler
(generate-redirect (basename->name-for-query target))] (define data (with-input-from-file fs-path (cdr archive-format)))
(define article-title (jp "/parse/title" data))
;; breezewiki doesn't have the page archived, see if we can make a network request for it (define original-page (html->xexp (preprocess-html-wiki (jp "/parse/text" data))))
[(not (config-true? 'feature_offline::only)) (define page ((query-selector (λ (t a c) (has-class? "mw-parser-output" a)) original-page)))
(next-dispatcher)] (define initial-head-data ((head-data-getter wikiname) data))
(define head-data
;; no possible way to provide the page (case theme
[else [(light dark)
(define mirror-path (url->string (request-uri req))) (struct-copy head-data^ initial-head-data
(define body [body-class (regexp-replace #rx"(theme-fandomdesktop-)(light|dark)"
(generate-wiki-page (head-data^-body-class initial-head-data)
`(div (@ (class "unsaved-page")) (format "\\1~a" theme))])]
(style ".unsaved-page a { text-decoration: underline !important }") [else initial-head-data]))
(p "breezewiki.com doesn't have this page saved.") (define body
(p "You can see this page by visiting a BreezeWiki mirror:") (generate-wiki-page
(ul (update-tree-wiki page wikiname)
(li (a (@ (href ,(format "https://antifandom.com~a" mirror-path))) "View on antifandom.com")) #:req req
(li (a (@ (href ,(format "https://bw.artemislena.eu~a" mirror-path))) "View on artemislena.eu")) #:source-url source-url
(li (a (@ (href ,source-url)) "or, you can see the original page on Fandom (ugh)"))) #:wikiname wikiname
(p "If you'd like " ,wikiname ".fandom.com to be added to breezewiki.com, " (a (@ (href "https://lists.sr.ht/~cadence/breezewiki-requests")) "let me know about it!"))) #:title article-title
#:req req #:online-styles #f
#:source-url source-url #:head-data head-data
#:wikiname wikiname #:siteinfo (siteinfo-fetch wikiname)
#:title (url-segments->guess-title segments) ))
#:online-styles #f (define redirect-msg ((query-selector (attribute-selector 'class "redirectMsg") body)))
#:siteinfo (siteinfo-fetch wikiname) (define redirect-query-parameter (dict-ref (url-query (request-uri req)) 'redirect "yes"))
)) (define headers
(when (config-true? 'debug) (build-headers
; used for its side effects always-headers
; convert to string with error checking, error will be raised if xexp is invalid ; redirect-query-parameter: only the string "no" is significant:
(xexp->html body)) ; https://github.com/Wikia/app/blob/fe60579a53f16816d65dad1644363160a63206a6/includes/Wiki.php#L367
(response/output (when (and redirect-msg
#:code 200 (not (equal? redirect-query-parameter "no")))
#:headers always-headers (let* ([dest (get-attribute 'href (bits->attributes ((query-selector (λ (t a c) (eq? t 'a)) redirect-msg))))]
(λ (out) [value (bytes-append #"0;url=" (string->bytes/utf-8 dest))])
(write-html body out)))]))) (header #"Refresh" value)))))
(when (config-true? 'debug)
; used for its side effects
; convert to string with error checking, error will be raised if xexp is invalid
(xexp->html body))
(response/output
#:code 200
#:headers headers
(λ (out)
(write-html body out))))])))