web: Add note about data retention act.
[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      (("/features.html"                    "Features")
76       ("/news.html"                        "News")
77       ("/people/index.html"                "People")
78       ("/service.html"                     "Service")))
79     ("/donate/index.html"
80      "Donate"
81      (("/donate/kudos.html"                "List of Donors")))
82     ("/download/index.html"
83      "Download"
84      (("/download/integrity_check.html"    "Integrity&nbsp;Check")
85       ("/download/supported_systems.html"  "Supported&nbsp;Systems")
86       ("/download/release_notes.html"      "Release&nbsp;Notes")
87       ("/download/mirrors.html"            "Mirrors")
88       ("/download/cvs_access.html"         "GIT")))
89     ("/documentation/index.html"
90      "Documentation"
91      (("/documentation/howtos.html"        "HOWTOs")
92       ("/documentation/manuals.html"       "Manuals")
93       ("/documentation/guides.html"        "Guides")
94       ("/documentation/faqs.html"          "FAQs")
95       ("/documentation/mailing-lists.html" "Mailing&nbsp;Lists")
96       ("/documentation/sites.html"         "Sites")
97       ("/documentation/bts.html"           "Bug&nbsp;Tracker")))
98     ("/related_software/index.html"
99      "Related software"
100      (("/related_software/frontends.html"  "Frontends")
101       ("/related_software/tools.html"      "Tools")
102       ("/related_software/libraries.html"  "Libraries")
103       ("/related_software/swlist.html"     "All")))
104     ("/blog/index.html"
105      "Blog"))
106   "The definition of the gnupg.org menu structure.")
107
108 (defconst gpgweb-gnupg-bottom-menu-alist
109   '(("/privacy-policy.html"
110      "Privacy&nbsp;Policy"
111      ())
112     ("/imprint.html"
113      "Imprint"
114      ())
115     ("/misc/index.html"
116      "Archive"
117      ())
118     ("/sitemap.html"
119      "Sitemap"
120      ())
121     ("/blog/index.html"
122      "Blog"
123      ()))
124   "The definition of the gnupg.org bottom menu structure.")
125
126
127 (defun gpgweb--any-selected-menu-p (menu selected-file)
128   "Return t if any item in MENU has been selected."
129   (let ((item (car menu))
130         res)
131     (when menu
132       (when item
133         (when (string= (car item) selected-file)
134             (setq res t))
135         (when (caddr item)
136           (when (gpgweb--any-selected-menu-p (caddr item) selected-file)
137             (setq res t))))
138       (when (gpgweb--any-selected-menu-p (cdr menu) selected-file)
139         (setq res t)))
140     res))
141
142
143 (defun gpgweb--selected-top-menu (menu selected-file)
144   "Return the selected top menu or nil."
145   (when menu
146     (let ((item (car menu)))
147       (if (and item
148                (or (string= (car item) selected-file)
149                    (gpgweb--any-selected-menu-p (caddr item) selected-file)))
150           menu
151         (gpgweb--selected-top-menu (cdr menu) selected-file)))))
152
153 (defun gpgweb--insert-menu (menu lvl selected-file)
154   "Helper function to insert the menu."
155   (when menu
156     (let ((item (car menu)))
157       (when item
158         (dotimes (i (1+ lvl)) (insert "  "))
159         (insert "  <li><a href=\"" (car item) "\"")
160         (when (or (string= (car item) selected-file)
161                   (gpgweb--any-selected-menu-p (caddr item) selected-file))
162           (insert " class=\"selected\""))
163         (insert  ">" (cadr item) "</a>\n")
164         (when (caddr item)
165           (dotimes (i (1+ lvl)) (insert "  "))
166           (insert "  <ul class=\"sub-menu\">\n")
167           (gpgweb--insert-menu (caddr item) (1+ lvl) selected-file)
168           (dotimes (i (1+ lvl)) (insert "  "))
169           (insert "  </ul>\n"))
170         (dotimes (i (1+ lvl)) (insert "  "))
171         (insert "  </li>\n")))
172     (gpgweb--insert-menu (cdr menu) lvl selected-file)))
173
174
175 (defun gpgweb--insert-submenu (menu selected-file)
176    "Helper function to insert the sub-menu."
177    (when menu
178      (let ((item (car menu)))
179        (when item
180          (insert "    <li><a href=\"" (car item) "\"")
181          (when (or (string= (car item) selected-file)
182                    (gpgweb--any-selected-menu-p (caddr item) selected-file))
183            (insert " class=\"selected\""))
184          (insert ">" (cadr item) "</a></li>\n")))
185      (gpgweb--insert-submenu (cdr menu) selected-file)))
186
187
188 (defun gpgweb-insert-menu (selected-file)
189   "Insert the menu structure into the HTML file."
190   (goto-char (point-min))
191   (when (re-search-forward "^<body>\n" nil t)
192     (insert "<div id=\"wrapper\">
193 <div id=\"header\"><a href=\"/index.html\" class=\"logo\"
194      ><img src=\"/share/logo-gnupg-light-purple-bg.png\"></a>&nbsp;</div>
195 <nav>
196   <ul>
197 ")
198     (gpgweb--insert-menu gpgweb-gnupg-menu-alist 0 selected-file)
199     (insert "  </ul>
200 </nav>
201 ")
202     (let ((m (caddr (car (gpgweb--selected-top-menu
203                           gpgweb-gnupg-menu-alist selected-file)))))
204       (when m
205           (insert "<nav class=\"subnav\">\n  <ul>\n")
206           (gpgweb--insert-submenu m selected-file)
207           (insert "  </ul>\n</nav>\n")))
208     (insert "<main>
209 <div id=\"content\">
210 ")))
211
212
213 (defun gpgweb-blog-index (orgfile filelist)
214   "Return the index of ORGFILE in FILELIST or nil if not found."
215   (let (found
216         (i 0))
217     (while (and filelist (not found))
218       (if (string= orgfile (car filelist))
219           (setq found i))
220       (setq i (1+ i))
221       (setq filelist (cdr filelist)))
222     found))
223
224 (defun gpgweb-blog-prev (fileidx filelist)
225   "Return the chronological previous file at FILEIDX from FILELIST
226 with the suffixed replaced by \"html\"."
227   (if (> fileidx 1)
228       (concat (file-name-sans-extension (nth (1- fileidx) filelist)) ".html")))
229
230 (defun gpgweb-blog-next (orgfile filelist)
231   "Return the chronological next file at FILEIDX from FILELIST
232 with the suffixed replaced by \"html\"."
233   (if (< fileidx (1- (length filelist)))
234       (concat (file-name-sans-extension (nth (1+ fileidx) filelist)) ".html")))
235
236 (defun gpgweb-fixup-blog (info orgfile filelist)
237   "Insert the blog specific content.  INFO is the usual
238 plist. ORGFILE is the name of the current source file without the
239 directory part.  If FILELIST is a list it has an ordered list of
240 org filenames."
241   (let ((authorstr (car (plist-get info :author)))
242         (datestr   (car (plist-get info :date))))
243     (goto-char (point-min))
244     (if (re-search-forward "^<main>" nil t)
245         (let* ((indexp (string= orgfile "index.org"))
246                (fileidx (if (listp filelist)
247                             (if indexp
248                                 (1- (length filelist))
249                               (gpgweb-blog-index orgfile filelist))))
250                (prevfile (if fileidx
251                              (gpgweb-blog-prev fileidx filelist)))
252                (nextfile (if (and fileidx (not indexp))
253                            (gpgweb-blog-next fileidx filelist))))
254           (move-beginning-of-line nil)
255           (insert "<nav class=\"subnav\">\n  <ul>\n")
256           (if prevfile
257               (insert "    <li><a href=\"" prevfile "\">Previous</a></li>\n"))
258           (insert
259            "    <li><a href=\"/blog/index.html#blogindex\">Index</a></li>\n")
260           (if nextfile
261               (insert "    <li><a href=\"" nextfile "\">Next</a></li>\n"))
262           (insert "  </ul>\n</nav>\n")))
263     (if (and datestr authorstr)
264         (if (re-search-forward "^<h2 id=.*\n" nil t)
265             (insert "<p class=\"postdate\">Posted "
266                     datestr
267                     " by "
268                     authorstr
269                     "</p>\n")))))
270
271
272 (defun gpgweb-insert-footer (htmlfile committed-at blogmode)
273   "Insert the footer.
274
275 HTMLFILE is HTML file name and COMMITTED-AT is the commit date
276 string of the source file or nil if not available."
277   (let ((srcfile (concat "https://git.gnupg.org/cgi-bin/gitweb.cgi?"
278                          "p=gnupg-doc.git;a=blob;f="
279                          (if blogmode "misc/blog.gnupg.org" "web")
280                          ;; The replace below is a hack to cope with
281                          ;; blogmode where HTMLFILE is like "./foo.html".
282                          (replace-regexp-in-string
283                           "^\\./" "/"
284                           (file-name-sans-extension htmlfile) t)
285                          ".org"))
286         (changed (if (and committed-at (>= (length committed-at) 10))
287                      (substring committed-at 0 10)
288                      "[unknown]")))
289     (goto-char (point-max))
290     (insert "</div><!-- end content -->
291 </main>
292 <div id=\"footer\">
293   <div id=\"nav_bottom\">
294   <ul>
295 ")
296     (gpgweb--insert-menu gpgweb-gnupg-bottom-menu-alist 0 nil)
297     (insert "  <li>
298 <a href=\"https://netzpolitik.org\"><img src=\"misc/vds_timeline-300x150.png\" title=\"Germany parliament again adopts data retention act - after the German (in 2010) and the European supreme court (in 2014) nixed such acts.\"></a></li>")
299     (insert "  </ul>
300   </div>
301 ")
302     (goto-char (point-min))
303     (unless (search-forward "<!--disable-copyright-footer-->" nil t)
304       (goto-char (point-max))
305       (insert "  <div id=\"cpyright\">
306     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
307       ><img alt=\"CC-BY-SA 3.0\" style=\"border: 0\"
308             src=\"/share/cc-by-sa-3.0_80x15.png\"/></a>&nbsp;
309     These web pages are
310     Copyright 1998--2015 The GnuPG Project and licensed under a
311     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
312     >Creative Commons Attribution-ShareAlike 3.0 Unported License</a>.  See
313     <a href=\"/copying.html\">copying</a> for details.
314     Page <a href=\"" srcfile "\">source</a> last changed on " changed ".
315   </div>\n"))
316   (goto-char (point-max))
317   (insert "</div>
318 </div><!-- end wrapper -->
319 </body>
320 </html>")))
321
322
323 ;;; Post-process the generated HTML file:
324 ;;;
325 ;;; - Insert header and footer
326 ;;; - Insert "class=selected" into the active menu entry
327 ;;; - Fixup sitemap.
328 ;;;
329 ;;; If blogmode is not nil the output is rendered as a blog.  BLOGMODE
330 ;;; may then contain an ordered list of org file names which are used
331 ;;; to create the previous and Next links for an entry.
332 ;;;
333 (defun gpgweb-postprocess-html (plist orgfile htmlfile blogmode)
334   (let* ((visitingp (find-buffer-visiting htmlfile))
335          (work-buffer (or visitingp (find-file-noselect htmlfile)))
336          (committed-at (shell-command-to-string
337                         (concat "git log -1 --format='%ci' -- " orgfile))))
338     (prog1 (with-current-buffer work-buffer
339              (let ((fname (file-name-nondirectory htmlfile))
340                    (fname-2 (replace-regexp-in-string
341                               ".*/stage\\(/.*\\)$" "\\1" htmlfile t))
342                    (title (org-publish-find-title orgfile)))
343                ;; Insert header, menu, and footer.
344                (gpgweb-insert-header title committed-at)
345                (gpgweb-insert-menu fname-2)
346                (if blogmode
347                    (gpgweb-fixup-blog plist
348                                       (file-name-nondirectory orgfile)
349                                       blogmode))
350                (gpgweb-insert-footer fname-2 committed-at blogmode)
351
352                ; Fixup the sitemap
353                (when (string-equal fname "sitemap.html")
354                  (goto-char (point-min))
355                  (while (re-search-forward
356                          "^.*<li>.*>\\(GnuPG - \\).*<span.*$" nil t)
357                    (replace-match "" t nil nil 1)))
358
359                ; Due to a problem with the current org exporter (cases
360                ; were we link to file mapped via a webserver alias) we
361                ; have to use a full URL at some places in the org
362                ; source.  We fix that up here.
363                (goto-char (point-min))
364                (while (re-search-forward
365                        "href=\"\\(https://www.gnupg.org\\)/.*\"" nil t)
366                  (replace-match "" t t nil 1))
367
368                ; If the wideright flag is used, change <td> and <th>
369                ; attributes.
370                (goto-char (point-min))
371                (when (search-forward "<!--table_data_wideright-->" nil t)
372                  (goto-char (point-min))
373                  (while (re-search-forward
374                          "^<t[hd].*class=\"\\(right\\)\".*$" nil t)
375                    (replace-match "right wideright" t nil nil 1)))
376
377                ; And save the changes
378                (basic-save-buffer))
379       (unless visitingp (kill-buffer work-buffer))))))
380
381
382 ;;;
383 ;;; The publishing function used by the HTML exporter
384 ;;;
385 (defun gpgweb-org-to-html (plist filename pub-dir)
386   (gpgweb-postprocess-html plist
387                            filename
388                            (org-gpgweb-publish-to-html plist filename pub-dir)
389                            nil))
390
391
392 ;;;
393 ;;; Turn the current buffer which has an org-mode blog entry into its
394 ;;; rendered form and save it with the suffix .html.
395 ;;;
396 (defun gpgweb-render-blog (&optional filelist)
397   (interactive)
398   (let* ((extplist '(:language "en"
399                      :section-numbers nil
400                      :tags nil
401                      :with-toc nil))
402          (orgfile (buffer-file-name))
403          (plist (org-export-get-environment 'gpgweb nil extplist))
404          (htmlfile (org-gpgweb-export-to-html nil nil nil t extplist)))
405     (gpgweb-postprocess-html plist orgfile htmlfile (if filelist filelist t))))
406
407
408 ;;;
409 ;;; Publish all blog entries in the current directory
410 ;;;
411 (defun gpgweb-publish-blogs ()
412   (interactive)
413   (let ((orgfiles (directory-files "." nil "^2[0-9]+-.*\.org$")))
414     (dolist (file (cons "index.org" orgfiles))
415       (let* ((visitingp (find-buffer-visiting file))
416              (work-buffer (or visitingp (find-file-noselect file))))
417         (with-current-buffer work-buffer
418           (gpgweb-render-blog orgfiles)
419           (basic-save-buffer))
420         (unless visitingp
421           (kill-buffer work-buffer))))))
422
423
424
425 (defun gpgweb-upload ()
426   (let ((stagedir (plist-get project-plist :publishing-directory)))
427     (message "gpgweb  rootdir '%s'" gpgweb-root-dir)
428     (message "gpgweb stagedir '%s'" stagedir)
429     (shell-command
430      (concat "cd " gpgweb-root-dir " && cd " stagedir
431              "&& rsync -rlt --exclude \"*~\" ./ "
432              "werner@trithemius.gnupg.org:"
433              "/var/www/www/www.gnupg.org/htdocs/ ;"
434              " ssh werner@trithemius.gnupg.org"
435              " touch /var/www/www/www.gnupg.org/htdocs/donate/donors.dat"))
436 ))
437
438 (provide 'gpgweb)