web: Add imprint 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 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>\n"))
70
71 (defconst gpgweb-gnupg-menu-alist
72   '(("/index.html"
73      "Home"
74      (("/features.html"                    "Features")
75       ("/news.html"                        "News")
76       ("/service.html"                     "Service")))
77     ("/donate/index.html"
78      "Donate"
79      (("/donate/kudos.html"                "List of Donors")))
80     ("/download/index.html"
81      "Download"
82      (("/download/integrity_check.html"    "Integrity&nbsp;Check")
83       ("/download/supported_systems.html"  "Supported&nbsp;Systems")
84       ("/download/release_notes.html"      "Release&nbsp;Notes")
85       ("/download/mirrors.html"            "Mirrors")
86       ("/download/cvs_access.html"         "GIT")))
87     ("/documentation/index.html"
88      "Documentation"
89      (("/documentation/howtos.html"        "HOWTOs")
90       ("/documentation/manuals.html"       "Manuals")
91       ("/documentation/guides.html"        "Guides")
92       ("/documentation/faqs.html"          "FAQs")
93       ("/documentation/mailing-lists.html" "Mailing&nbsp;Lists")
94       ("/documentation/sites.html"         "Sites")
95       ("/documentation/bts.html"           "Bug&nbsp;Tracker")))
96     ("/related_software/index.html"
97      "Related software"
98      (("/related_software/frontends.html"  "Frontends")
99       ("/related_software/tools.html"      "Tools")
100       ("/related_software/libraries.html"  "Libraries")
101       ("/related_software/swlist.html"     "All")))
102     ("/blog/index.html"
103      "Blog"
104      ())
105     ("/privacy-policy.html"
106      "Privacy&nbsp;Policy"
107      ())
108     ("/imprint.html"
109      "Imprint"
110      ())
111     ("/misc/index.html"
112      "Archive"
113      ())
114     ("/sitemap.html"
115      "Sitemap"
116      ()))
117   "The definition of the gnupg.org menu structure.")
118
119 (defun gpgweb--any-selected-menu-p (menu selected-file)
120   "Return t if any item in MENU has been selected."
121   (let ((item (car menu))
122         res)
123     (when menu
124       (when item
125         (when (string= (car item) selected-file)
126             (setq res t))
127         (when (caddr item)
128           (when (gpgweb--any-selected-menu-p (caddr item) selected-file)
129             (setq res t))))
130       (when (gpgweb--any-selected-menu-p (cdr menu) selected-file)
131         (setq res t)))
132     res))
133
134
135 (defun gpgweb--insert-menu (menu lvl selected-file)
136   "Helper function to insert the menu."
137   (when menu
138     (let ((item (car menu))
139           sel)
140       (when item
141         (dotimes (i lvl) (insert "  "))
142         (insert "    <li><a href=\"" (car item) "\"")
143         (when (string= (car item) selected-file)
144           (setq sel t)
145           (insert " class=\"selected\""))
146         (insert  ">" (cadr item) "</a></li>\n")
147         (when (and (caddr item)
148                    (or
149                     sel
150                     (gpgweb--any-selected-menu-p (caddr item) selected-file)))
151           (dotimes (i (1+ lvl)) (insert "  "))
152           (insert "  <ul>\n")
153           (gpgweb--insert-menu (caddr item) (1+ lvl) selected-file)
154           (dotimes (i (1+ lvl)) (insert "  "))
155           (insert "  </ul>\n"))))
156     (gpgweb--insert-menu (cdr menu) lvl selected-file)))
157
158 (defun gpgweb-insert-menu (selected-file)
159   "Insert the menu structure into the HTML file."
160   (goto-char (point-min))
161   (when (re-search-forward "^<body>\n" nil t)
162     (insert "<div id=\"header\">&nbsp;</div>
163 <div id=\"leftColumn\">
164   <nav>
165   <ul>
166 ")
167     (gpgweb--insert-menu gpgweb-gnupg-menu-alist 0 selected-file)
168     (insert "  </ul>
169   </nav>
170 </div>
171 <main>
172 ")))
173
174 (defun gpgweb-insert-footer ()
175   (goto-char (point-min))
176   (unless (search-forward "<!--disable-copyright-footer-->" nil t)
177     (goto-char (point-max))
178     (insert "<div id=\"cpyright\">
179     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
180       ><img alt=\"CC-BY-SA 3.0\" style=\"border: 0\"
181             src=\"/share/cc-by-sa-3.0_80x15.png\"/></a><br/>
182     These web pages are
183     Copyright 1998--2014 The GnuPG Project<a href=\"/copying.html\">ยน</a>
184     and licensed under a
185     <a rel=\"license\" href=\"http://creativecommons.org/licenses/by-sa/3.0/\"
186     >Creative Commons Attribution-ShareAlike 3.0 Unported License</a>.  See
187     <a href=\"/copying.html\">copying</a> for details.
188 </div>
189 </main>
190 </body>
191 </html>")))
192
193
194 ;;; Post-process the generated HTML file:
195 ;;;
196 ;;; - Insert header and footer
197 ;;; - Insert "class=selected" into the active menu entry
198 ;;; - Fixup sitemap.
199 (defun gpgweb-postprocess-html (plist orgfile htmlfile)
200   (let* ((visitingp (find-buffer-visiting htmlfile))
201          (work-buffer (or visitingp (find-file-noselect htmlfile)))
202          (committed-at (shell-command-to-string
203                         (concat "git log -1 --format='%ci' -- " orgfile))))
204     (prog1 (with-current-buffer work-buffer
205              (let ((fname (file-name-nondirectory htmlfile))
206                    (fname-2 (replace-regexp-in-string
207                              ".*/stage\\(/.*\\)$" "\\1" htmlfile t))
208                    (title (org-publish-find-title orgfile)))
209                ;; Insert header, menu, and footer.
210                (gpgweb-insert-header title committed-at)
211                (gpgweb-insert-menu fname-2)
212                (gpgweb-insert-footer)
213
214                ; Fixup the sitemap
215                (when (string-equal fname "sitemap.html")
216                  (goto-char (point-min))
217                  (while (re-search-forward
218                          "^.*<li>.*>\\(GnuPG - \\).*<span.*$" nil t)
219                    (replace-match "" t nil nil 1)))
220
221                ; Due to a problem with the current org exporter (cases
222                ; were we link to file mapped via a webserver alias) we
223                ; have to use a full URL at some places in the org
224                ; source.  We fix that up here.
225                (goto-char (point-min))
226                (while (re-search-forward
227                        "href=\"\\(https://www.gnupg.org\\)/.*\"" nil t)
228                  (replace-match "" t t nil 1))
229
230                ; And save the changes
231                (basic-save-buffer))
232       (unless visitingp (kill-buffer work-buffer))))))
233
234
235 ;;;
236 ;;; The publishing function used by the HTML exporter
237 ;;;
238 (defun gpgweb-org-to-html (plist filename pub-dir)
239   (gpgweb-postprocess-html plist filename
240                            (org-gpgweb-publish-to-html plist filename pub-dir)))
241
242
243 (defun gpgweb-upload ()
244   (let ((stagedir (plist-get project-plist :publishing-directory)))
245     (message "gpgweb  rootdir '%s'" gpgweb-root-dir)
246     (message "gpgweb stagedir '%s'" stagedir)
247     (shell-command
248      (concat "cd " gpgweb-root-dir " && cd " stagedir
249              "&& rsync -rlt --exclude \"*~\" ./ "
250              "werner@trithemius.gnupg.org:"
251              "/var/www/www/www.gnupg.org/htdocs/ ;"
252              " ssh werner@trithemius.gnupg.org"
253              " touch /var/www/www/www.gnupg.org/htdocs/donate/donors.dat"))
254 ))
255
256 (provide 'gpgweb)