defs.rkt 9.11 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
                    (if (clab?) (js-style-addition "gcse-cloudlab.js") null)
50 51 52
                    (make-css-addition "highlight-default.css"))))


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

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

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

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

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

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

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

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

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

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

(define forum-url
104
  (case (tb-mode)
Gary Wong's avatar
Gary Wong committed
105 106
	('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
107
	('pnet "https://groups.google.com/forum/#!forum/phantomnet-users")
Robert Ricci's avatar
Robert Ricci committed
108
	('powder "https://groups.google.com/forum/#!forum/powder-users")
Gary Wong's avatar
Gary Wong committed
109
	('elab "https://groups.google.com/forum/#!forum/emulab-users")))
Gary Wong's avatar
Gary Wong committed
110

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

118 119 120 121
; 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"))))
122

123 124
; Arbitrary width that works reasonably well with the manual class's main
; column width
125 126 127 128 129 130
(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
131

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

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

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

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

180 181 182 183 184 185
(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!"))))

186
(define geni-lib-hash null)
187
(define (parse-sphinx-inventory directory)
188
  (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)))))))
189 190 191

;  (regexp-match #px"(?m:^\\s+([^\\s]+)\\s+([^\\s]+)$)"
;                (read-sphinx-inventory directory)))
192
    
193
(define (geni-lib-link identifier)
194 195 196 197
  (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))))))
198

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

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

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

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

(define (ssh)
  (tt "ssh"))
221

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

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

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

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

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

248
(define (code-sample filename [extra null])
249 250 251 252
  ; 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)))
253
    extra
254
    (elem #:style downloadable-code-sample-style (file->string (string-append "code-samples/" filename)))))