blog: Wrote upload and indexing script.
[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 COMMITED-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   "The definition of the gnupg.org menu structure.")
105
106 (defconst gpgweb-gnupg-bottom-menu-alist
107   '(("/privacy-policy.html"
108      "Privacy&nbsp;Policy"
109      ())
110     ("/imprint.html"
111      "Imprint"
112      ())
113     ("/misc/index.html"
114      "Archive"
115      ())
116     ("/sitemap.html"
117      "Sitemap"
118      ())
119     ("/blog/index.html"
120      "Blog"
121      ()))
122   "The definition of the gnupg.org bottom menu structure.")
123
124
125 (defun gpgweb--any-selected-menu-p (menu selected-file)
126   "Return t if any item in MENU has been selected."
127   (let ((item (car menu))
128         res)
129     (when menu
130       (when item
131         (when (string= (car item) selected-file)
132             (setq res t))
133         (when (caddr item)
134           (when (gpgweb--any-selected-menu-p (caddr item) selected-file)
135             (setq res t))))
136       (when (gpgweb--any-selected-menu-p (cdr menu) selected-file)
137         (setq res t)))
138     res))
139
140
141 (defun gpgweb--selected-top-menu (menu selected-file)
142   "Return the selected top menu or nil."
143   (when menu
144     (let ((item (car menu)))
145       (if (and item
146                (or (string= (car item) selected-file)
147                    (gpgweb--any-selected-menu-p (caddr item) selected-file)))
148           menu
149         (gpgweb--selected-top-menu (cdr menu) selected-file)))))
150
151 (defun gpgweb--insert-menu (menu lvl selected-file)
152   "Helper function to insert the menu."
153   (when menu
154     (let ((item (car menu)))
155       (when item
156         (dotimes (i (1+ lvl)) (insert "  "))
157         (insert "  <li><a href=\"" (car item) "\"")
158         (when (or (string= (car item) selected-file)
159                   (gpgweb--any-selected-menu-p (caddr item) selected-file))
160           (insert " class=\"selected\""))
161         (insert  ">" (cadr item) "</a>\n")
162         (when (caddr item)
163           (dotimes (i (1+ lvl)) (insert "  "))
164           (insert "  <ul class=\"sub-menu\">\n")
165           (gpgweb--insert-menu (caddr item) (1+ lvl) selected-file)
166           (dotimes (i (1+ lvl)) (insert "  "))
167           (insert "  </ul>\n"))
168         (dotimes (i (1+ lvl)) (insert "  "))
169         (insert "  </li>\n")))
170     (gpgweb--insert-menu (cdr menu) lvl selected-file)))
171
172
173 (defun gpgweb--insert-submenu (menu selected-file)
174    "Helper function to insert the sub-menu."
175    (when menu
176      (let ((item (car menu)))
177        (when item
178          (insert "    <li><a href=\"" (car item) "\"")
179          (when (or (string= (car item) selected-file)
180                    (gpgweb--any-selected-menu-p (caddr item) selected-file))
181            (insert " class=\"selected\""))
182          (insert ">" (cadr item) "</a></li>\n")))
183      (gpgweb--insert-submenu (cdr menu) selected-file)))
184
185
186 (defun gpgweb-insert-menu (selected-file)
187   "Insert the menu structure into the HTML file."
188   (goto-char (point-min))
189   (when (re-search-forward "^<body>\n" nil t)
190     (insert "<div id=\"wrapper\">
191 <div id=\"header\"><a href=\"/index.html\" class=\"logo\"
192      ><img src=\"/share/logo-gnupg-light-purple-bg.png\"></a>&nbsp;</div>
193 <nav>
194   <ul>
195 ")
196     (gpgweb--insert-menu gpgweb-gnupg-menu-alist 0 selected-file)
197     (insert "  </ul>
198 </nav>
199 ")
200     (let ((m (caddr (car (gpgweb--selected-top-menu
201                           gpgweb-gnupg-menu-alist selected-file)))))
202       (when m
203           (insert "<nav class=\"subnav\">\n  <ul>\n")
204           (gpgweb--insert-submenu m selected-file)
205           (insert "  </ul>\n</nav>\n")))
206     (insert "<main>
207 <div id=\"content\">
208 ")))
209
210
211 (defun gpgweb-blog-index (orgfile filelist)
212   "Return the index of ORGFILE in FILELIST or nil if not found."
213   (let (found
214         (i 0))
215     (while (and filelist (not found))
216       (if (string= orgfile (car filelist))
217           (setq found i))
218       (setq i (1+ i))
219       (setq filelist (cdr filelist)))
220     found))
221
222 (defun gpgweb-blog-prev (fileidx filelist)
223   "Return the chronological previous file at FILEIDX from FILELIST
224 with the suffixed replaced by \"html\"."
225   (if (> fileidx 1)
226       (concat (file-name-sans-extension (nth (1- fileidx) filelist)) ".html")))
227
228 (defun gpgweb-blog-next (orgfile filelist)
229   "Return the chronological next file at FILEIDX from FILELIST
230 with the suffixed replaced by \"html\"."
231   (if (< fileidx (1- (length filelist)))
232       (concat (file-name-sans-extension (nth (1+ fileidx) filelist)) ".html")))
233
234 (defun gpgweb-fixup-blog (info orgfile filelist)
235   "Insert the blog specific content.  INFO is the usual
236 plist. ORGFILE is the name of the current source file without the
237 directory part.  If FILELIST is a list it has an ordered list of
238 org filenames."
239   (let ((authorstr (car (plist-get info :author)))
240         (datestr   (car (plist-get info :date))))
241     (goto-char (point-min))
242     (if (re-search-forward "^<main>" nil t)
243         (let* ((indexp (string= orgfile "index.org"))
244                (fileidx (if (listp filelist)
245                             (if indexp
246                                 (1- (length filelist))
247                               (gpgweb-blog-index orgfile filelist))))
248                (prevfile (if fileidx
249                              (gpgweb-blog-prev fileidx filelist)))
250                (nextfile (if (and fileidx (not indexp))
251                            (gpgweb-blog-next fileidx filelist))))
252           (move-beginning-of-line nil)
253           (insert "<nav class=\"subnav\">\n  <ul>\n")
254           (if prevfile
255               (insert "    <li><a href=\"" prevfile "\">Previous</a></li>\n"))
256           (insert
257            "    <li><a href=\"/blog/index.html#blogindex\">Index</a></li>\n")
258           (if nextfile
259               (insert "    <li><a href=\"" nextfile "\">Next</a></li>\n"))
260           (insert "  </ul>\n</nav>\n")))
261     (if (and datestr authorstr)
262         (if (re-search-forward "^<h2 id=.*\n" nil t)
263             (insert "<p class=\"postdate\">Posted "
264                     datestr
265                     " by "
266                     authorstr
267                     "</p>\n")))))
268
269
270 (defun gpgweb-insert-footer ()
271   (goto-char (point-max))
272   (insert "</div><!-- end content -->
273 </main>
274 <div id=\"footer\">
275   <div id=\"nav_bottom\">
276   <ul>
277 ")
278   (gpgweb--insert-menu gpgweb-gnupg-bottom-menu-alist 0 nil)
279   (insert "  </ul>
280   </div>
281 ")
282   (goto-char (point-min))
283   (unless (search-forward "<!--disable-copyright-footer-->" nil t)
284     (goto-char (point-max))
285     (insert "  <div id=\"cpyright\">
286     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
287       ><img alt=\"CC-BY-SA 3.0\" style=\"border: 0\"
288             src=\"/share/cc-by-sa-3.0_80x15.png\"/></a>&nbsp;
289     These web pages are
290     Copyright 1998--2014 The GnuPG Project and licensed under a
291     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
292     >Creative Commons Attribution-ShareAlike 3.0 Unported License</a>.  See
293     <a href=\"/copying.html\">copying</a> for details.
294   </div>\n"))
295   (goto-char (point-max))
296   (insert "</div>
297 </div><!-- end wrapper -->
298 </body>
299 </html>"))
300
301
302 ;;; Post-process the generated HTML file:
303 ;;;
304 ;;; - Insert header and footer
305 ;;; - Insert "class=selected" into the active menu entry
306 ;;; - Fixup sitemap.
307 ;;;
308 ;;; If blogmode is not nil the output is rendered as a blog.  BLOGMODE
309 ;;; may then contain an ordered list of org file names which are used
310 ;;; to create the previous and Next links for an entry.
311 ;;;
312 (defun gpgweb-postprocess-html (plist orgfile htmlfile blogmode)
313   (let* ((visitingp (find-buffer-visiting htmlfile))
314          (work-buffer (or visitingp (find-file-noselect htmlfile)))
315          (committed-at (shell-command-to-string
316                         (concat "git log -1 --format='%ci' -- " orgfile))))
317     (prog1 (with-current-buffer work-buffer
318              (let ((fname (file-name-nondirectory htmlfile))
319                    (fname-2 (replace-regexp-in-string
320                              ".*/stage\\(/.*\\)$" "\\1" htmlfile t))
321                    (title (org-publish-find-title orgfile)))
322                ;; Insert header, menu, and footer.
323                (gpgweb-insert-header title committed-at)
324                (gpgweb-insert-menu fname-2)
325                (if blogmode
326                    (gpgweb-fixup-blog plist
327                                       (file-name-nondirectory orgfile)
328                                       blogmode))
329                (gpgweb-insert-footer)
330
331                ; Fixup the sitemap
332                (when (string-equal fname "sitemap.html")
333                  (goto-char (point-min))
334                  (while (re-search-forward
335                          "^.*<li>.*>\\(GnuPG - \\).*<span.*$" nil t)
336                    (replace-match "" t nil nil 1)))
337
338                ; Due to a problem with the current org exporter (cases
339                ; were we link to file mapped via a webserver alias) we
340                ; have to use a full URL at some places in the org
341                ; source.  We fix that up here.
342                (goto-char (point-min))
343                (while (re-search-forward
344                        "href=\"\\(https://www.gnupg.org\\)/.*\"" nil t)
345                  (replace-match "" t t nil 1))
346
347                ; And save the changes
348                (basic-save-buffer))
349       (unless visitingp (kill-buffer work-buffer))))))
350
351
352 ;;;
353 ;;; The publishing function used by the HTML exporter
354 ;;;
355 (defun gpgweb-org-to-html (plist filename pub-dir)
356   (gpgweb-postprocess-html plist
357                            filename
358                            (org-gpgweb-publish-to-html plist filename pub-dir)
359                            nil))
360
361
362 ;;;
363 ;;; Turn the current buffer which has an org-mode blog entry into its
364 ;;; rendered form and save it with the suffix .html.
365 ;;;
366 (defun gpgweb-render-blog (&optional filelist)
367   (interactive)
368   (let* ((extplist '(:language "en"
369                      :section-numbers nil
370                      :tags nil
371                      :with-toc nil))
372          (orgfile (buffer-file-name))
373          (plist (org-export-get-environment 'gpgweb nil extplist))
374          (htmlfile (org-gpgweb-export-to-html nil nil nil t extplist)))
375     (gpgweb-postprocess-html plist orgfile htmlfile (if filelist filelist t))))
376
377
378 ;;;
379 ;;; Publish all blog entries in the current directory
380 ;;;
381 (defun gpgweb-publish-blogs ()
382   (interactive)
383   (let ((orgfiles (directory-files "." nil "^2[0-9]+-.*\.org$")))
384     (dolist (file (cons "index.org" orgfiles))
385       (let* ((visitingp (find-buffer-visiting file))
386              (work-buffer (or visitingp (find-file-noselect file))))
387         (with-current-buffer work-buffer
388           (gpgweb-render-blog orgfiles)
389           (basic-save-buffer))
390         (unless visitingp
391           (kill-buffer work-buffer))))))
392
393
394
395 (defun gpgweb-upload ()
396   (let ((stagedir (plist-get project-plist :publishing-directory)))
397     (message "gpgweb  rootdir '%s'" gpgweb-root-dir)
398     (message "gpgweb stagedir '%s'" stagedir)
399     (shell-command
400      (concat "cd " gpgweb-root-dir " && cd " stagedir
401              "&& rsync -rlt --exclude \"*~\" ./ "
402              "werner@trithemius.gnupg.org:"
403              "/var/www/www/www.gnupg.org/htdocs/ ;"
404              " ssh werner@trithemius.gnupg.org"
405              " touch /var/www/www/www.gnupg.org/htdocs/donate/donors.dat"))
406 ))
407
408 (provide 'gpgweb)