defs.rkt 9.04 KB
Newer Older
1
#lang racket/base
Robert Ricci's avatar
Robert Ricci committed
2
(require scribble/base)
3
(require scribble/core)
4
(require scribble/decode)
5
(require scribble/manual)
6
(require scribble/private/defaults)
7 8
(require scribble/html-properties)
(require scribble/latex-properties)
9 10
(require racket/class)
(require racket/draw)
11 12
(require racket/system)
(require racket/port)
13
(require racket/vector)
14
(require racket/file)
15
(require racket/cmdline)
16 17 18

(provide (all-defined-out))

19 20
(define tb-mode (make-parameter 'apt))
(define doc-mode (make-parameter 'html))
21
(define include-ga (make-parameter #f))
22 23 24 25 26 27 28 29
(define geni-lib-dir (make-parameter null))

(command-line
  #:program "testbed-manual"
  #:once-any
  ["--apt" "Compile manual for Apt" (tb-mode 'apt)]
  ["--clab" "Compile manual for CloudLab" (tb-mode 'clab)]
  ["--pnet" "Compile manual for PhantomNet" (tb-mode 'pnet)]
30
  ["--powder" "Compile manual for Powder" (tb-mode 'powder)]
31 32 33
  ["--elab" "Compile manual for Emulab" (tb-mode 'elab)]
  #:once-each
  ["--pdf"  "Compile PDF version of the manual" (doc-mode 'pdf)]
34
  ["--ga"   "Include Google Analytics code" (include-ga #t)]
35 36 37 38 39 40
  ["--geni-lib-dir" gld  "Give the path to geni-lib" (geni-lib-dir gld)]
)

(define (apt?) (if (equal? (tb-mode) 'apt) #t #f))
(define (clab?)  (if (equal? (tb-mode) 'clab) #t #f))
(define (pnet?)  (if (equal? (tb-mode) 'pnet) #t #f))
41
(define (powder?)  (if (equal? (tb-mode) 'powder) #t #f))
42
(define (elab?)  (if (equal? (tb-mode) 'elab) #t #f))
43

44 45 46 47
(define main-style
  (make-style "main-body"
              (list (js-style-addition "highlight.pack.js")
                    (js-style-addition "download-code.js")
48
                    (if (and (clab?) (include-ga)) (js-style-addition "ga-cloudlab.js") null)
49 50 51
                    (make-css-addition "highlight-default.css"))))


52
(define (apt-vs-clab #:apt [apt-version (list)] #:clab [clab-version (list)] #:pnet [pnet-version (list)] #:powder [powder-version (list)] #:elab [elab-version (list)])
53
  (case (tb-mode)
Gary Wong's avatar
Gary Wong committed
54 55
	('apt apt-version)
	('clab clab-version)
Gary Wong's avatar
Gary Wong committed
56
	('pnet pnet-version)
57
	('powder powder-version)
Gary Wong's avatar
Gary Wong committed
58
	('elab elab-version)))
59

60
(define (apt-vs-clab* #:apt [apt-version ""] #:clab [clab-version ""] #:pnet [pnet-version ""] #:powder [powder-version ""] #:elab [elab-version ""])
61
  (decode-flow (list (case (tb-mode)
Gary Wong's avatar
Gary Wong committed
62 63
			   ('apt apt-version)
			   ('clab clab-version)
Gary Wong's avatar
Gary Wong committed
64
			   ('pnet pnet-version)
65
			   ('powder powder-version)
Gary Wong's avatar
Gary Wong committed
66
			   ('elab elab-version)))))
67

68
(define (apt-only . stuff)
69
  (apt-vs-clab #:apt stuff))
70

71
(define (clab-only . stuff)
72
  (apt-vs-clab #:clab stuff))
73

Gary Wong's avatar
Gary Wong committed
74 75 76
(define (pnet-only . stuff)
  (apt-vs-clab #:pnet stuff))

77 78 79
(define (powder-only . stuff)
  (apt-vs-clab #:powder stuff))

Gary Wong's avatar
Gary Wong committed
80 81 82
(define (elab-only . stuff)
  (apt-vs-clab #:elab stuff))

83 84 85
(define (wireless-only . stuff)
  (apt-vs-clab #:pnet stuff #:powder stuff))

86
(define apt-base-url
87
  (case (tb-mode)
Gary Wong's avatar
Gary Wong committed
88 89
	('apt "https://www.aptlab.net/")
	('clab "https://www.cloudlab.us/")
Gary Wong's avatar
Gary Wong committed
90
	('pnet "https://www.phantomnet.org/")
91
	('powder "https://www.powderwireless.net/")
92
	('elab "https://www.emulab.net/portal/")))
93

94
(define apt-doc-url
95
  (case (tb-mode)
Gary Wong's avatar
Gary Wong committed
96 97
	('apt "http://docs.aptlab.net/")
	('clab "http://docs.cloudlab.us/")
Gary Wong's avatar
Gary Wong committed
98
	('pnet "http://docs.phantomnet.org/")
99
	('powder "http://docs.powderwireless.net/")
100
	('elab "http://docs.emulab.net/")))
Gary Wong's avatar
Gary Wong committed
101 102

(define forum-url
103
  (case (tb-mode)
Gary Wong's avatar
Gary Wong committed
104 105
	('apt "https://groups.google.com/forum/#!forum/apt-users")
	('clab "https://groups.google.com/forum/#!forum/cloudlab-users")
Gary Wong's avatar
Gary Wong committed
106
	('pnet "https://groups.google.com/forum/#!forum/phantomnet-users")
Robert Ricci's avatar
Robert Ricci committed
107
	('powder "https://groups.google.com/forum/#!forum/powder-users")
Gary Wong's avatar
Gary Wong committed
108
	('elab "https://groups.google.com/forum/#!forum/emulab-users")))
Gary Wong's avatar
Gary Wong committed
109

110
(define tb (lambda () (case (tb-mode)
Gary Wong's avatar
Gary Wong committed
111 112
			    ('apt "Apt")
			    ('clab "CloudLab")
Gary Wong's avatar
Gary Wong committed
113
			    ('pnet "PhantomNet")
114
			    ('powder "Powder")
Gary Wong's avatar
Gary Wong committed
115
			    ('elab "Emulab"))))
116

117 118 119 120
; We want the 'version' to be the date of the most recent commit
(define apt-version
  (with-output-to-string
    (lambda () (system "git show -s --date=short --format='%cd (%h)' HEAD"))))
121

122 123
; Arbitrary width that works reasonably well with the manual class's main
; column width
124 125 126 127 128 129
(define screenshot-width 650)

(define apturl
  (case-lambda
    [() apt-base-url]
    [(page) (string-append apt-base-url page)]))
Robert Ricci's avatar
Robert Ricci committed
130

131
(define (TODO . what)
132
  (bold "TODO: " (decode-content what)))
133 134

(define nodetype
135
  (lambda (typename howmany summary . properties)
136 137 138
          (tabular #:style 'boxed #:sep (hspace 3)
                   (cons
                     (list (bold typename)
139
                           (string-append (number->string howmany) " nodes" " (" summary ")"))
140
                     properties))))
141

142
(define (screenshot path)
143 144
  (let* ([aptpath (string-append "screenshots/apt/" path)]
         [clabpath (string-append "screenshots/clab/" path)]
Gary Wong's avatar
Gary Wong committed
145
         [pnetpath (string-append "screenshots/pnet/" path)]
146
         [powderpath (string-append "screenshots/powder/" path)]
Gary Wong's avatar
Gary Wong committed
147
         [elabpath (string-append "screenshots/elab/" path)]
148
         [fullpath (case (tb-mode)
Gary Wong's avatar
Gary Wong committed
149 150 151 152 153 154 155 156
			 ('apt aptpath)
			 ('clab
			  (if (file-exists? clabpath)
			      clabpath
			    (cdr (cons (displayln (string-append "WARNING: CloudLab missing screenshot " path)) aptpath))))
			 ('pnet
			  (if (file-exists? pnetpath)
			      pnetpath
Gary Wong's avatar
Gary Wong committed
157
			    (cdr (cons (displayln (string-append "WARNING: PhantomNet missing screenshot " path)) aptpath))))
158 159 160 161
			 ('powder
			  (if (file-exists? powderpath)
			      powderpath
			    (cdr (cons (displayln (string-append "WARNING: Powder missing screenshot " path)) aptpath))))
Gary Wong's avatar
Gary Wong committed
162 163
			 ('elab
			  (if (file-exists? elabpath)
164
			      elabpath
Gary Wong's avatar
Gary Wong committed
165
			    (cdr (cons (displayln (string-append "WARNING: Emulab missing screenshot " path)) aptpath)))))]
166 167
         [b (make-object bitmap% fullpath)]
         [width (send b get-width)]
168
         [scale-factor (* 1.0 (/ screenshot-width width))])
169 170 171
    (list (image #:scale scale-factor fullpath fullpath) (linebreak))))

(define (instructionstep step #:screenshot [screenshot-path #f] . body)
172 173
  (item (bold (decode-content (list step)))
        (linebreak)
174
        (decode-flow body)
175 176
        (if screenshot-path
          (screenshot  screenshot-path)
177
          (void))))
178

179 180 181 182 183 184
(define (read-sphinx-inventory directory)
  (let ([inv-file (string-append directory "/objects.inv")])
    (if (file-exists? inv-file)
        (with-output-to-string (lambda () (system (string-append "/usr/bin/env python -msphinx.ext.intersphinx " inv-file))))
        (exit (string-append inv-file) " doesn't exist!"))))

185
(define geni-lib-hash null)
186
(define (parse-sphinx-inventory directory)
187
  (set! geni-lib-hash (make-hash (filter pair? (map (lambda (x) (let ([match (regexp-match #px"\\s+([^\\s]+)[\\s:]+([^\\s]+)$" x)]) (if match (cdr match) #f))) (regexp-split #px"\n" (read-sphinx-inventory directory)))))))
188 189 190

;  (regexp-match #px"(?m:^\\s+([^\\s]+)\\s+([^\\s]+)$)"
;                (read-sphinx-inventory directory)))
191
    
192
(define (geni-lib-link identifier)
193 194 195 196
  (if (not identifier)
    "geni-lib/index.html"
    (let* ([fullid (if (regexp-match #rx"^geni\\." identifier) identifier (string-append "geni." identifier))])
         (string-append "geni-lib/" (car (hash-ref geni-lib-hash fullid))))))
197

198 199 200
(define (last-token identifier)
  (car (regexp-match #px"[^\\.]*$" identifier)))

201
(define (geni-lib [identifier #f] [display #f])
202 203
  (hyperlink (geni-lib-link identifier)
             (bold (code (cond
204
                           [(not identifier) "geni-lib"]
205 206 207 208
                           [(string? display) display]
                           [(equal? display 'func) (string-append (last-token identifier) "()")]
                           [(equal? display 'id) (string-append (last-token identifier))]
                           [else identifier])))))
209

210 211
(define (under-construction)
  (bold "This section is under construction"))
212 213 214 215 216

(define (future-work tag)
  (margin-note "There are planned features relating to this section: see \""
               (secref tag)
               "\" for more details."))
217 218 219

(define (ssh)
  (tt "ssh"))
220

221 222 223 224 225
(define code-sample-style
  (make-style "code-sample"
              (list (make-css-addition "code-sample.css")
                    (make-tex-addition "code-sample.tex"))))

226 227 228 229 230
(define profile-sample-style
  (make-style "profile-sample"
              (list (make-css-addition "code-sample.css")
                    (make-tex-addition "code-sample.tex"))))

231 232
(define downloadable-code-sample-style
  (make-style "downloadable-code-sample"
233 234
              (list (make-css-addition "code-sample.css")
                    (make-tex-addition "code-sample.tex"))))
235

236 237 238
(define (profile-url project profile)
  (apturl (string-append "p/" project "/" profile)))

239 240
(define (profile-code-sample project profile)
  (let
241 242
    ([filename (string-append "profile/" project "/" profile ".py")])
    (list
243 244
      (code-sample filename
      (elem #:style profile-sample-style (hyperlink (profile-url project profile)
245
                 (string-append "Open this profile on " (tb))))))))
246

247
(define (code-sample filename [extra null])
248 249 250 251
  ; We include the code sample twice; the second time, it's hidden. This is
  ; so that we get to keep a 'clean' copy for the download button
  (list
    (elem #:style code-sample-style (file->string (string-append "code-samples/" filename)))
252
    extra
253
    (elem #:style downloadable-code-sample-style (file->string (string-append "code-samples/" filename)))))