web: Add a separate Security page.
[gnupg-doc.git] / web / share / gpgweb.el
1 ;;; gpgweb.el --- elisp helper code for the GnuPG web pages
2
3 (require 'org-exp)
4
5 (defun gpgweb-setup-project ()
6   "Set up an org-publish project for the gnupg.org website."
7   (progn
8    (require 'ox-gpgweb (concat gpgweb-root-dir "share/ox-gpgweb.el"))
9    (aput 'org-publish-project-alist "gpgweb-org"
10    '(:base-directory "~/s/gnupg-doc/web"
11      :base-extension "org"
12      :language "en"
13      :html-extension "html"
14      :recursive t
15      :publishing-directory "../stage"
16      :publishing-function gpgweb-org-to-html
17      :body-only t
18      :section-numbers nil
19      :tags nil
20      :with-toc nil
21      :makeindex t
22      :auto-sitemap nil
23      :sitemap-title "GnuPG - Sitemap"
24      :sitemap-sort-folders "last"
25      :sitemap-file-entry-format "%t  @@html:<span id=\"smallnote\">@@(%d)@@html:</span>@@"
26      :style-include-default nil
27      :timestamp-file nil
28      :html-head "<link rel=\"stylesheet\" href=\"gnupg.css\" type=\"text/css\" />"
29      :html-head-include-scripts nil))
30
31    (aput 'org-publish-project-alist "gpgweb-other"
32    '(:base-directory "."
33      :base-extension "jpg\\|png\\|css\\|txt\\|rss\\|lst\\|sig"
34      :recursive t
35      :publishing-directory "../stage"
36      :publishing-function org-publish-attachment
37      :completion-function gpgweb-upload))
38
39    (aput 'org-publish-project-alist "gpgweb"
40    '(:components ("gpgweb-org" "gpgweb-other")))))
41
42
43 (defun gpgweb-insert-header (title committed-at)
44   "Insert the header.
45
46 COMMITTED-AT is the commit date string of the source file or nil
47 if not available."
48   (goto-char (point-min))
49   (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>
50 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
51                \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
52 <html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"en\" xml:lang=\"en\">
53 <head>
54 <title>" title "</title>
55 <meta http-equiv=\"Content-Type\" content=\"text/html;charset=utf-8\" />\n")
56   (when (and committed-at (>= (length committed-at) 10))
57       (insert "<meta name=\"DC.Date\" content=\""
58               (substring committed-at 0 10) "\" />\n"))
59   (insert "<meta name=\"DC.Language\" content=\"en\" />
60 <meta name=\"DC.Title\" content=\"" title "\" />
61 <meta name=\"DC.Description\"
62  content=\"GnuPG is a free implementation of OpenPGP\" />
63 <meta name=\"DC.Creator\" content=\"The People of the GnuPG Project\" />
64 <meta name=\"DC.Publisher\" content=\"The GnuPG Project\" />
65 <meta name=\"DC.Identifier\" content=\"https://gnupg.org/\" />
66 <meta name=\"DC.Rights\" content=\"https://gnupg.org/copying.html\" />
67 <link rel=\"stylesheet\" href=\"/share/site.css\" type=\"text/css\" />
68 </head>
69 <body>
70 "))
71
72 (defconst gpgweb-gnupg-menu-alist
73   '(("/index.html"
74      "Home"
75      (("/index.html"                       "Home")
76       ("/features.html"                    "Features")
77       ("/news.html"                        "News")
78       ("/people/index.html"                "People")
79       ("/documentation/sites.html"         "Sites")
80       ("/service.html"                     "Service")))
81     ("/donate/index.html"
82      "Donate"
83      (("/donate/index.html"                "Donate")
84       ("/donate/kudos.html"                "List of Donors")))
85     ("/download/index.html"
86      "Download"
87      (("/download/index.html"              "Download")
88       ("/download/integrity_check.html"    "Integrity&nbsp;Check")
89       ("/download/supported_systems.html"  "Supported&nbsp;Systems")
90       ("/download/release_notes.html"      "Release&nbsp;Notes")
91       ("/download/mirrors.html"            "Mirrors")
92       ("/download/cvs_access.html"         "GIT")))
93     ("/documentation/index.html"
94      "Support"
95      (("/documentation/howtos.html"        "HOWTOs")
96       ("/documentation/manuals.html"       "Manuals")
97       ("/documentation/guides.html"        "Guides")
98       ("/documentation/faqs.html"          "FAQs")
99       ("/documentation/mailing-lists.html" "Mailing&nbsp;Lists")
100       ("/documentation/bts.html"           "Bug&nbsp;Tracker")
101       ("/documentation/security.html"      "Security")))
102     ("/related_software/index.html"
103      "Related software"
104      (("/related_software/frontends.html"  "Frontends")
105       ("/related_software/tools.html"      "Tools")
106       ("/related_software/libraries.html"  "Libraries")
107       ("/related_software/swlist.html"     "All")))
108     ("/blog/index.html"
109      "Blog"))
110   "The definition of the gnupg.org menu structure.")
111
112 (defconst gpgweb-gnupg-bottom-menu-alist
113   '(("/privacy-policy.html"
114      "Privacy&nbsp;Policy"
115      ())
116     ("/imprint.html"
117      "Imprint"
118      ())
119     ("/misc/index.html"
120      "Archive"
121      ())
122     ("/sitemap.html"
123      "Sitemap"
124      ())
125     ("/blog/index.html"
126      "Blog"
127      ()))
128   "The definition of the gnupg.org bottom menu structure.")
129
130
131 (defun gpgweb--any-selected-menu-p (menu selected-file)
132   "Return t if any item in MENU has been selected."
133   (let ((item (car menu))
134         res)
135     (when menu
136       (when item
137         (when (string= (car item) selected-file)
138             (setq res t))
139         (when (caddr item)
140           (when (gpgweb--any-selected-menu-p (caddr item) selected-file)
141             (setq res t))))
142       (when (gpgweb--any-selected-menu-p (cdr menu) selected-file)
143         (setq res t)))
144     res))
145
146
147 (defun gpgweb--selected-top-menu (menu selected-file)
148   "Return the selected top menu or nil."
149   (when menu
150     (let ((item (car menu)))
151       (if (and item
152                (or (string= (car item) selected-file)
153                    (gpgweb--any-selected-menu-p (caddr item) selected-file)))
154           menu
155         (gpgweb--selected-top-menu (cdr menu) selected-file)))))
156
157 (defun gpgweb--insert-menu (menu lvl selected-file)
158   "Helper function to insert the menu."
159   (when menu
160     (let ((item (car menu)))
161       (when item
162         (dotimes (i (1+ lvl)) (insert "  "))
163         (insert "  <li><a href=\"" (car item) "\"")
164         (when (or (string= (car item) selected-file)
165                   (gpgweb--any-selected-menu-p (caddr item) selected-file))
166           (insert " class=\"selected\""))
167         (insert  ">" (cadr item) "</a>\n")
168         (when (caddr item)
169           (dotimes (i (1+ lvl)) (insert "  "))
170           (insert "  <ul class=\"sub-menu\">\n")
171           (gpgweb--insert-menu (caddr item) (1+ lvl) selected-file)
172           (dotimes (i (1+ lvl)) (insert "  "))
173           (insert "  </ul>\n"))
174         (dotimes (i (1+ lvl)) (insert "  "))
175         (insert "  </li>\n")))
176     (gpgweb--insert-menu (cdr menu) lvl selected-file)))
177
178
179 (defun gpgweb--insert-submenu (menu selected-file)
180    "Helper function to insert the sub-menu."
181    (when menu
182      (let ((item (car menu)))
183        (when item
184          (insert "    <li><a href=\"" (car item) "\"")
185          (when (or (string= (car item) selected-file)
186                    (gpgweb--any-selected-menu-p (caddr item) selected-file))
187            (insert " class=\"selected\""))
188          (insert ">" (cadr item) "</a></li>\n")))
189      (gpgweb--insert-submenu (cdr menu) selected-file)))
190
191
192 (defun gpgweb-insert-menu (selected-file)
193   "Insert the menu structure into the HTML file."
194   (goto-char (point-min))
195   (when (re-search-forward "^<body>\n" nil t)
196     (insert "<div id=\"wrapper\">
197 <div id=\"header\"><a href=\"/index.html\" class=\"logo\"
198      ><img src=\"/share/logo-gnupg-light-purple-bg.png\"></a>&nbsp;</div>
199 <nav>
200   <ul>
201 ")
202     (gpgweb--insert-menu gpgweb-gnupg-menu-alist 0 selected-file)
203     (insert "  </ul>
204 </nav>
205 ")
206     (let ((m (caddr (car (gpgweb--selected-top-menu
207                           gpgweb-gnupg-menu-alist selected-file)))))
208       (when m
209           (insert "<nav class=\"subnav\">\n  <ul>\n")
210           (gpgweb--insert-submenu m selected-file)
211           (insert "  </ul>\n</nav>\n")))
212     (insert "<main>
213 <div id=\"content\">
214 ")))
215
216
217 (defun gpgweb-blog-index (orgfile filelist)
218   "Return the index of ORGFILE in FILELIST or nil if not found."
219   (let (found
220         (i 0))
221     (while (and filelist (not found))
222       (if (string= orgfile (car filelist))
223           (setq found i))
224       (setq i (1+ i))
225       (setq filelist (cdr filelist)))
226     found))
227
228 (defun gpgweb-blog-prev (fileidx filelist)
229   "Return the chronological previous file at FILEIDX from FILELIST
230 with the suffixed replaced by \"html\"."
231   (if (> fileidx 1)
232       (concat (file-name-sans-extension (nth (1- fileidx) filelist)) ".html")))
233
234 (defun gpgweb-blog-next (orgfile filelist)
235   "Return the chronological next file at FILEIDX from FILELIST
236 with the suffixed replaced by \"html\"."
237   (if (< fileidx (1- (length filelist)))
238       (concat (file-name-sans-extension (nth (1+ fileidx) filelist)) ".html")))
239
240 (defun gpgweb-fixup-blog (info orgfile filelist)
241   "Insert the blog specific content.  INFO is the usual
242 plist. ORGFILE is the name of the current source file without the
243 directory part.  If FILELIST is a list it has an ordered list of
244 org filenames."
245   (let ((authorstr (car (plist-get info :author)))
246         (datestr   (car (plist-get info :date))))
247     (goto-char (point-min))
248     (if (re-search-forward "^<main>" nil t)
249         (let* ((indexp (string= orgfile "index.org"))
250                (fileidx (if (listp filelist)
251                             (if indexp
252                                 (1- (length filelist))
253                               (gpgweb-blog-index orgfile filelist))))
254                (prevfile (if fileidx
255                              (gpgweb-blog-prev fileidx filelist)))
256                (nextfile (if (and fileidx (not indexp))
257                            (gpgweb-blog-next fileidx filelist))))
258           (move-beginning-of-line nil)
259           (insert "<nav class=\"subnav\">\n  <ul>\n")
260           (if prevfile
261               (insert "    <li><a href=\"" prevfile "\">Previous</a></li>\n"))
262           (insert
263            "    <li><a href=\"/blog/index.html#blogindex\">Index</a></li>\n")
264           (if nextfile
265               (insert "    <li><a href=\"" nextfile "\">Next</a></li>\n"))
266           (insert "  </ul>\n</nav>\n")))
267     (if (and datestr authorstr)
268         (if (re-search-forward "^<h2 id=.*\n" nil t)
269             (insert "<p class=\"postdate\">Posted "
270                     datestr
271                     " by "
272                     authorstr
273                     "</p>\n")))))
274
275
276 (defun gpgweb-insert-footer (htmlfile committed-at blogmode)
277   "Insert the footer.
278
279 HTMLFILE is HTML file name and COMMITTED-AT is the commit date
280 string of the source file or nil if not available."
281   (let ((srcfile (concat "https://git.gnupg.org/cgi-bin/gitweb.cgi?"
282                          "p=gnupg-doc.git;a=blob;f="
283                          (if blogmode "misc/blog.gnupg.org" "web")
284                          ;; The replace below is a hack to cope with
285                          ;; blogmode where HTMLFILE is like "./foo.html".
286                          (replace-regexp-in-string
287                           "^\\./" "/"
288                           (file-name-sans-extension htmlfile) t)
289                          ".org"))
290         (changed (if (and committed-at (>= (length committed-at) 10))
291                      (substring committed-at 0 10)
292                      "[unknown]")))
293     (goto-char (point-max))
294     (insert "</div><!-- end content -->
295 </main>
296 <div id=\"footer\">
297   <div id=\"nav_bottom\">
298   <ul>
299 ")
300     (gpgweb--insert-menu gpgweb-gnupg-bottom-menu-alist 0 nil)
301     (insert "    </ul>
302   </div>
303 ")
304     (insert "  <div class=\"footerbox\">
305   <a><img src=\"/share/traueranzeige-g10_v2015.png\"
306           width=\"200px\" height=\"73px\"
307           alt=\"Traueranzeige: Wir nehmen Abschied von einem sicher geglaubten Freund, dem | Fernmeldegeheimniss | (Artikel 10 Grundgesetz) | * 23. Mai 1949, + 18. Dezember 2015\"
308           title=\"Article 10 of the German constitution (communication privacy) is not anymore with us.\" /></a>
309   <p></p>
310   </div>
311 ")
312     (goto-char (point-min))
313     (unless (search-forward "<!--disable-copyright-footer-->" nil t)
314       (goto-char (point-max))
315       (insert "  <div id=\"cpyright\">
316     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
317       ><img alt=\"CC-BY-SA 3.0\" style=\"border: 0\"
318             src=\"/share/cc-by-sa-3.0_80x15.png\"/></a>&nbsp;
319     These web pages are
320     Copyright 1998--2015 The GnuPG Project and licensed under a
321     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
322     >Creative Commons Attribution-ShareAlike 3.0 Unported License</a>.  See
323     <a href=\"/copying.html\">copying</a> for details.
324     Page <a href=\"" srcfile "\">source</a> last changed on " changed ".
325   </div>\n"))
326   (goto-char (point-max))
327   (insert "</div>
328 </div><!-- end wrapper -->
329 </body>
330 </html>")))
331
332
333 ;;; Post-process the generated HTML file:
334 ;;;
335 ;;; - Insert header and footer
336 ;;; - Insert "class=selected" into the active menu entry
337 ;;; - Fixup sitemap.
338 ;;;
339 ;;; If blogmode is not nil the output is rendered as a blog.  BLOGMODE
340 ;;; may then contain an ordered list of org file names which are used
341 ;;; to create the previous and Next links for an entry.
342 ;;;
343 (defun gpgweb-postprocess-html (plist orgfile htmlfile blogmode)
344   (let* ((visitingp (find-buffer-visiting htmlfile))
345          (work-buffer (or visitingp (find-file-noselect htmlfile)))
346          (committed-at (shell-command-to-string
347                         (concat "git log -1 --format='%ci' -- " orgfile))))
348     (prog1 (with-current-buffer work-buffer
349              (let ((fname (file-name-nondirectory htmlfile))
350                    (fname-2 (replace-regexp-in-string
351                               ".*/stage\\(/.*\\)$" "\\1" htmlfile t))
352                    (title (org-publish-find-title orgfile)))
353                ;; Insert header, menu, and footer.
354                (gpgweb-insert-header title committed-at)
355                (gpgweb-insert-menu fname-2)
356                (if blogmode
357                    (gpgweb-fixup-blog plist
358                                       (file-name-nondirectory orgfile)
359                                       blogmode))
360                (gpgweb-insert-footer fname-2 committed-at blogmode)
361
362                ; Fixup the sitemap
363                (when (string-equal fname "sitemap.html")
364                  (goto-char (point-min))
365                  (while (re-search-forward
366                          "^.*<li>.*>\\(GnuPG - \\).*<span.*$" nil t)
367                    (replace-match "" t nil nil 1)))
368
369                ; Due to a problem with the current org exporter (cases
370                ; were we link to file mapped via a webserver alias) we
371                ; have to use a full URL at some places in the org
372                ; source.  We fix that up here.
373                (goto-char (point-min))
374                (while (re-search-forward
375                        "href=\"\\(https://www.gnupg.org\\)/.*\"" nil t)
376                  (replace-match "" t t nil 1))
377
378                ; If the wideright flag is used, change <td> and <th>
379                ; attributes.
380                (goto-char (point-min))
381                (when (search-forward "<!--table_data_wideright-->" nil t)
382                  (goto-char (point-min))
383                  (while (re-search-forward
384                          "^<t[hd].*class=\"\\(right\\)\".*$" nil t)
385                    (replace-match "right wideright" t nil nil 1)))
386
387                ; And save the changes
388                (basic-save-buffer))
389       (unless visitingp (kill-buffer work-buffer))))))
390
391
392 ;;;
393 ;;; The publishing function used by the HTML exporter
394 ;;;
395 (defun gpgweb-org-to-html (plist filename pub-dir)
396   (gpgweb-postprocess-html plist
397                            filename
398                            (org-gpgweb-publish-to-html plist filename pub-dir)
399                            nil))
400
401
402 ;;;
403 ;;; Turn the current buffer which has an org-mode blog entry into its
404 ;;; rendered form and save it with the suffix .html.
405 ;;;
406 (defun gpgweb-render-blog (&optional filelist)
407   (interactive)
408   (let* ((extplist '(:language "en"
409                      :section-numbers nil
410                      :tags nil
411                      :with-toc nil))
412          (orgfile (buffer-file-name))
413          (plist (org-export-get-environment 'gpgweb nil extplist))
414          (htmlfile (org-gpgweb-export-to-html nil nil nil t extplist)))
415     (gpgweb-postprocess-html plist orgfile htmlfile (if filelist filelist t))))
416
417
418 ;;;
419 ;;; Publish all blog entries in the current directory
420 ;;;
421 (defun gpgweb-publish-blogs ()
422   (interactive)
423   (let ((orgfiles (directory-files "." nil "^2[0-9]+-.*\.org$")))
424     (dolist (file (cons "index.org" orgfiles))
425       (let* ((visitingp (find-buffer-visiting file))
426              (work-buffer (or visitingp (find-file-noselect file))))
427         (with-current-buffer work-buffer
428           (gpgweb-render-blog orgfiles)
429           (basic-save-buffer))
430         (unless visitingp
431           (kill-buffer work-buffer))))))
432
433
434
435 (defun gpgweb-upload ()
436   (let ((stagedir (plist-get project-plist :publishing-directory)))
437     (message "gpgweb  rootdir '%s'" gpgweb-root-dir)
438     (message "gpgweb stagedir '%s'" stagedir)
439     (shell-command
440      (concat "cd " gpgweb-root-dir " && cd " stagedir
441              "&& rsync -rlt --exclude \"*~\" ./ "
442              "werner@trithemius.gnupg.org:"
443              "/var/www/www/www.gnupg.org/htdocs/ ;"
444              " ssh werner@trithemius.gnupg.org"
445              " touch /var/www/www/www.gnupg.org/htdocs/donate/donors.dat"))
446 ))
447
448 (provide 'gpgweb)