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