PageRenderTime 17ms CodeModel.GetById 10ms app.highlight 2ms RepoModel.GetById 2ms app.codeStats 0ms

/dylan/main.dylan

http://github.com/cgay/wiki
Unknown | 454 lines | 412 code | 42 blank | 0 comment | 0 complexity | 10612c4e82b7e3df76187c8fc7a383f2 MD5 | raw file
  1Module: %wiki
  2
  3// These are sent as the text and URL for the Atom feed generator element.
  4define variable *site-name* :: <string> = "Dylan Wiki";
  5define variable *site-url* :: <string> = "";
  6
  7// The realm used for authentication.  Configurable.
  8define variable *wiki-realm* :: <string> = "wiki";
  9
 10define variable *mail-host* = #f;
 11define variable *mail-port* :: <integer> = $default-smtp-port;
 12
 13define constant $administrator-user-name :: <string> = "administrator";
 14
 15/// This is called when the <wiki> element in the config file is
 16/// processed.
 17define sideways method process-config-element
 18    (server :: <http-server>, node :: xml/<element>, name == #"wiki")
 19  // TODO(cgay): error out if any of the files configured here don't exist,
 20  // including executables.
 21  let git-exe = get-attr(node, #"git-executable")
 22                | "git";
 23  let wiki-root = get-attr(node, #"wiki-root")
 24                  | error("The wiki-root setting is required.");
 25  let wiki-root-directory = as(<directory-locator>, wiki-root);
 26  let main-root = get-attr(node, #"git-main-repository-root")
 27                  | error("The git-main-repository-root setting is required.");
 28  let user-root = get-attr(node, #"git-user-repository-root")
 29                  | error("The git-user-repository-root setting is required.");
 30  *storage* := make(<git-storage>,
 31                    repository-root: as(<directory-locator>, main-root),
 32                    user-repository-root: as(<directory-locator>, user-root),
 33                    executable: as(<file-locator>, git-exe));
 34  initialize-storage-for-reads(*storage*);
 35
 36  local method child-node-named (name)
 37          block (return)
 38            for (child in xml/node-children(node))
 39              if (xml/name(child) = name)
 40                return(child);
 41              end;
 42            end;
 43          end;
 44        end;
 45
 46  let admin-element = child-node-named(#"administrator");
 47  if (~admin-element)
 48    error("An <administrator> element must be specified in the config file.");
 49  end;
 50  let (admin-user, changed?) = process-administrator-configuration(admin-element);
 51  initialize-storage-for-writes(*storage*, admin-user);
 52  if (changed?)
 53    store(*storage*, admin-user, admin-user, "Change due to config file edit",
 54          standard-meta-data(admin-user, "edit"));
 55  end;
 56  *admin-user* := admin-user;
 57  *users*[admin-user.user-name] := admin-user;
 58
 59  *site-name* := get-attr(node, #"site-name") | *site-name*;
 60  log-info("Site name: %s", *site-name*);
 61
 62  *site-url*  := get-attr(node, #"site-url")  | *site-url*;
 63  // TODO: set site-url to http://<local host name>:<port>
 64  log-info("Site URL: %s", *site-url*);
 65
 66  *wiki-url-prefix* := get-attr(node, #"url-prefix") | *wiki-url-prefix*;
 67  log-info("Wiki URL prefix: %s", *wiki-url-prefix*);
 68
 69  *static-directory* := subdirectory-locator(wiki-root-directory, "www");
 70  *template-directory* := subdirectory-locator(*static-directory*, "dsp");
 71  log-info("Wiki static directory: %s", *static-directory*);
 72
 73  let auth-element = child-node-named(#"authentication");
 74  if (auth-element)
 75    process-authentication-configuration(auth-element);
 76  end;
 77
 78  let mail-element = child-node-named(#"mail");
 79  if (mail-element)
 80    process-mail-configuration(mail-element);
 81  else
 82    error("A <mail> element must be specified in the config file.");
 83  end;
 84
 85  *python-executable* := get-attr(node, #"python-executable")
 86    | error("The 'python-executable' attribute must be specified in the 'wiki' "
 87            "config file element.");
 88  *rst2html* := get-attr(node, #"rst2html")
 89    | error("The 'rst2html' attribute must be specified in the 'wiki' "
 90            "config file element.");
 91  *rst2html-template* := as(<string>,
 92                            merge-locators(as(<file-locator>, "rst2html-template.txt"),
 93                                           wiki-root-directory));
 94end method process-config-element;
 95
 96define method process-administrator-configuration
 97    (admin-element :: xml/<element>)
 98  let password = get-attr(admin-element, #"password");
 99  let email = get-attr(admin-element, #"email");
100  if (~(password & email))
101    error("The <administrator> element must be specified in the config file "
102          "with a password and email.");
103  end;
104  let password = validate-password(password);
105  let email = validate-email(email);
106  let admin = find-user($administrator-user-name);
107  let admin-changed? = #f;
108  if (admin)
109    if (admin.user-password ~= password)
110      admin.user-password := password;
111      admin-changed? := #t;
112      log-info("Administrator user (%s) password changed.", $administrator-user-name);
113    end;
114    if (admin.user-email ~= email)
115      admin.user-email := email;
116      admin-changed? := #t;
117      log-info("Administrator user (%s) email changed to %=.",
118               $administrator-user-name, email);
119    end;
120  else
121    admin := make(<wiki-user>,
122                  name: $administrator-user-name,
123                  password: password,
124                  email: email,
125                  administrator?: #t,
126                  activated?: #t);
127    admin-changed? := #t;
128    log-info("Administrator user (%s) created.", $administrator-user-name);
129  end;
130  *users*[admin.user-name] := admin;
131  values(*admin-user* := admin, admin-changed?)
132end method process-administrator-configuration;
133
134define method process-authentication-configuration
135    (auth-element :: xml/<element>)
136  let realm = get-attr(auth-element, #"realm");
137  if (realm)
138    *wiki-realm* := realm;
139    log-info("Authentication realm set to %=", realm);
140  end;
141end process-authentication-configuration;
142
143define method process-mail-configuration
144    (mail-element :: xml/<element>)
145  let host = get-attr(mail-element, #"host");
146  let port = get-attr(mail-element, #"port");
147  if (host)
148    *mail-host* := host;
149  else
150    error("The <mail> configuration element must have a 'host' attribute.");
151  end;
152  if (port)
153    *mail-port* := string-to-integer(port);
154  end;
155end method process-mail-configuration;
156
157define function restore-from-text-files
158    () => (num-page-revs)
159  let wikidata = as(<directory-locator>, "/home/cgay/wiki-data");
160  format-out("Restoring wiki data from %s\n", as(<string>, wikidata));
161  let page-data = make(<stretchy-vector>);
162  local method gather-page-data (directory, filename, type)
163          // look for "page-<page-num>-<rev-num>.props"
164          let parts = split(filename, '.');
165          if (type = #"file" & parts.size = 2 & parts[1] = "props")
166            let parts = split(parts[0], '-');
167            if (parts.size = 3 & parts[0] = "page")
168              let page-num = string-to-integer(parts[1]);
169              let rev-num = string-to-integer(parts[2]);
170              add!(page-data, pair(page-num, rev-num));
171            end;
172          end;
173        end;
174  local method less? (pd1, pd2)
175          pd1.head < pd2.head | (pd1.head = pd2.head & pd1.tail < pd2.tail)
176        end;
177  local method page-locator (page-num, rev-num, extension)
178          let filename = format-to-string("page-%d-%d.%s",
179                                          page-num, rev-num, extension);
180          merge-locators(as(<file-locator>, filename), wikidata)
181        end;
182  local method parse-line (stream)
183          // e.g. "author: hannes"
184          let line = read-line(stream);
185          let parts = split(line, ':', count: 2);
186          copy-sequence(parts[1], start: min(parts[1].size, 1))
187        end;
188  // Load users in this format:
189  // username
190  // password
191  // email
192  // <blank line>
193  let user-locator = merge-locators(as(<file-locator>, "users.txt"), wikidata);
194  with-open-file(stream = user-locator)
195    let user-count = 0;
196    block ()
197      while (#t)
198        let username = read-line(stream);
199        let password = read-line(stream);
200        let email = read-line(stream);
201        if (~find-user(username))
202          let user = make(<wiki-user>,
203                          name: username,
204                          password: password,
205                          email: email,
206                          administrator?: #f,
207                          activated?: #t);
208          store(*storage*, user, *admin-user*, "New user",
209                standard-meta-data(user, "create"));
210          inc!(user-count);
211        end;
212        assert(empty?(read-line(stream)));
213      end;
214    exception (ex :: <end-of-stream-error>)
215      // done
216    end;
217  end;
218  do-directory(gather-page-data, wikidata);
219  page-data := sort(page-data, test: less?);
220  let administrator = find-user("administrator")
221        | error("No 'administrator' user found.  Run the new wiki without "
222                "the --restore option first, so the administrator account "
223                "will be created when the config file is loaded.");
224  let previous-page-num = #f;
225  for (pd in page-data)
226    let page-num = pd.head;
227    let rev-num = pd.tail;
228    with-open-file(stream = page-locator(page-num, rev-num, "props"))
229      let title = parse-line(stream);
230      let author = find-user(parse-line(stream)) | administrator;
231      let timestamp = parse-iso8601-string(parse-line(stream));
232      let comment = parse-line(stream);
233      let page = find-page(title);
234      if (~page)
235        let source = file-contents(page-locator(page-num, rev-num, "content"));
236        page := make(<wiki-page>,
237                     title: title,
238                     source: source,
239                     owner: author);
240      end;
241      store(*storage*, page, author, comment, standard-meta-data(page, "create"));
242    end;
243  end for;
244  page-data.size
245end function restore-from-text-files;
246
247
248// There is method to this madness....  In general a GET generates a "view"
249// or "confirm" page and a POST actually performs the operation, such as
250// create, edit, or delete.  The same basic scheme is used for each type of
251// object: pages, users, and groups.  Here's the example for groups:
252//   GET  /group/list           => list groups (has <form> to create group)
253//   POST /group/list           => create new group
254//   GET  /group/view/<name>    => view group
255//   GET  /group/edit/<name>    => display "edit group" form
256//   POST /group/edit/<name>    => save group from form fields
257//   GET  /group/remove/<name>  => display "remove group" form
258//   POST /group/remove/<name>  => remove group
259//   ...
260// In most cases a single URL points to an instance of <wiki-dsp> for both
261// GET and POST, and the methods for respond-to-get and respond-to-post
262// handle the logic for the given HTTP request method.
263
264define function add-wiki-responders
265    (http-server :: <http-server>)
266  initialize-pages();
267  local method add (url, resource, #rest args)
268          apply(add-resource,
269                http-server, concatenate(*wiki-url-prefix*, url), resource,
270                args);
271        end;
272  add("/static", make(<directory-resource>, directory: *static-directory*));
273
274  add("/", make(<redirecting-resource>, target: wiki-url("/page/view/Home")),
275      url-name: "wiki.home");
276  add("/login", function-resource(curry(login, realm: *wiki-realm*)),
277      url-name: "wiki.login");
278  add("/logout", function-resource(logout),
279      url-name: "wiki.logout");
280  add("/recent-changes",
281      make(<recent-changes-page>, source: "list-recent-changes.dsp"),
282      url-name: "wiki.recent-changes");
283  /* TODO:
284  add("/feed/{type?}/{name?}", function-resource(atom-feed-responder),
285      url-name: "wiki.atom-feed");
286  */
287
288  add("/user/list", *list-users-page*,
289      url-name: "wiki.user.list");
290  // TODO: support the {revision?} path element.  Requires a revision
291  //       slot in wiki-object.
292  add("/user/view/{name}/{revision?}", *view-user-page*,
293      url-name: "wiki.user.view");
294  add("/user/edit/{name}", *edit-user-page*,
295      url-name: "wiki.user.edit");
296  add("/user/activate/{name}/{key}",
297      function-resource(respond-to-user-activation-request),
298      url-name: "wiki.user.activate");
299  add("/user/deactivate/{name}", *deactivate-user-page*,
300      url-name: "wiki.user.deactivate");
301
302  add("/register", *registration-page*,
303      url-name: "wiki.register");
304
305  // Provide backward compatibility with old wiki URLs.
306  // Note no url-name argument since we don't want this URL generated.
307  add("/wiki/view.dsp", function-resource(show-page-back-compatible));
308
309  add("/page/list",
310      make(<list-pages-page>, source: "list-pages.dsp"),
311      url-name: "wiki.page.list");
312  add("/page/view/{title}/{version?}", *view-page-page*,
313      url-name: "wiki.page.view");
314  // TODO: rename {version} to {revision}
315  add("/page/edit/{title}/{version?}",
316      make(<edit-page-page>, source: "edit-page.dsp"),
317      url-name: "wiki.page.edit");
318  add("/page/remove/{title}/{version?}", *remove-page-page*,
319      url-name: "wiki.page.remove");
320  add("/page/history/{title}/{revision?}", *page-history-page*,
321      url-name: "wiki.page.versions");
322  add("/page/diff/{title}/{version1}", *view-diff-page*,
323      url-name: "wiki.page.diff");
324  add("/page/connections/{title}", *connections-page*,
325      url-name: "wiki.page.connections");
326  add("/page/access/{title}", *edit-access-page*,
327      url-name: "wiki.page.access");
328
329  add("/group/list", *list-groups-page*,
330      url-name: "wiki.group.list");
331  // TODO: support the {revision?} path element.  Requires a revision
332  //       slot in wiki-object.
333  add("/group/view/{name}/{revision?}", *view-group-page*,
334      url-name: "wiki.group.view");
335  add("/group/edit/{name}", *edit-group-page*,
336      url-name: "wiki.group.edit");
337  add("/group/remove/{name}", *remove-group-page*,
338      url-name: "wiki.group.remove");
339  add("/group/members/{name}", *edit-group-members-page*,
340      url-name: "wiki.group.members");
341
342    /***** We'll use Google or Yahoo custom search, at least for a while
343    url wiki-url("/search")
344      action (get, post) () => $search-page;
345    */
346
347end function add-wiki-responders;
348
349// Called after config file loaded.
350define function initialize-wiki
351    (server :: <http-server>)
352  if (~get-option-value(*command-line-parser*, "config"))
353    error("You must specify a config file with the --config option.");
354  end;
355  add-wiki-responders(server);
356  preload-wiki-data();
357end function initialize-wiki;
358
359define function preload-wiki-data ()
360  // Load all wiki data.  Not serving yet, so no lock needed.
361  for (user in load-all(*storage*, <wiki-user>))
362    *users*[user.user-name] := user;
363  end;
364  for (group in load-all(*storage*, <wiki-group>))
365    *groups*[group.group-name] := group;
366  end;
367  // TODO: This won't scale.
368  for (page in load-all(*storage*, <wiki-page>))
369    *pages*[page.page-title] := page;
370  end;
371
372  for (page in *pages*)
373    update-reference-tables!(page, #(), page.outbound-references);
374  end;
375end function preload-wiki-data;
376
377// This is pretty horrifying, but the plan is to eventually make it all
378// disappear behind a somewhat less horrifying macro like "define site".
379//
380define function initialize-pages
381    ()
382  // page pages
383  *view-diff-page* := make(<view-diff-page>, source: "view-diff.dsp");
384  *edit-page-page* := make(<edit-page-page>, source: "edit-page.dsp");
385  *view-page-page* := make(<view-page-page>, source: "view-page.dsp");
386  *remove-page-page* := make(<remove-page-page>, source: "remove-page.dsp");
387  *page-history-page* := make(<page-history-page>, source: "view-page-history.dsp");
388  *connections-page* := make(<connections-page>, source: "page-connections.dsp");
389  *search-page* := make(<wiki-dsp>, source: "search-page.dsp");
390  *non-existing-page-page* := make(<wiki-dsp>, source: "non-existing-page.dsp");
391
392  // user pages
393  *list-users-page* := make(<list-users-page>, source: "list-users.dsp");
394  *view-user-page* := make(<view-user-page>, source: "view-user.dsp");
395  *edit-user-page* := make(<edit-user-page>, source: "edit-user.dsp");
396  *deactivate-user-page* := make(<deactivate-user-page>, source: "deactivate-user.dsp");
397  *non-existing-user-page* := make(<wiki-dsp>, source: "non-existing-user.dsp");
398  *not-logged-in-page* := make(<wiki-dsp>, source: "not-logged-in.dsp");
399
400  // group pages
401  *list-groups-page* := make(<list-groups-page>, source: "list-groups.dsp");
402  *non-existing-group-page* := make(<wiki-dsp>, source: "non-existing-group.dsp");
403  *view-group-page* := make(<view-group-page>, source: "view-group.dsp");
404  *edit-group-page* := make(<edit-group-page>, source: "edit-group.dsp");
405  *remove-group-page* := make(<remove-group-page>, source: "remove-group.dsp");
406  *edit-group-members-page* := make(<edit-group-members-page>,
407                                    source: "edit-group-members.dsp");
408
409  // other pages
410  *registration-page* := make(<registration-page>, source: "register.dsp");
411  *edit-access-page* := make(<acls-page>, source: "edit-page-access.dsp");
412
413end function initialize-pages;
414
415/*
416The conversion procedure probably is like this:
417
418* Run the modified old wiki code, which will write out all the wiki
419  pages to text files.  /home/cgay/wiki-conversion-libraries/
420* BACKUP THE WIKI DATABASE!
421* Run the new wiki code briefly, just so it can read in the config
422  file and create the administrator user.
423  The next step will use these if it finds them.  Shut down the wiki.
424* Run the new wiki code again with the --restore command-line argument.
425*/
426define function main
427    ()
428  if (member?("--restore", application-arguments(), test: \=))
429    // need to handle the --config argument here so the content directory is set.
430    // Remove this when the old, pre-turbo wiki is dead.
431    let parser = *command-line-parser*;
432    parse-command-line(parser, application-arguments());
433    let config-file = get-option-value(parser, "config");
434    if (config-file)
435      // we just cons up a server here because all we care about is that
436      // the <wiki> setting is processed.
437      configure-server(make(<http-server>), config-file);
438    end;
439    format-out("Restored %d page revisions\n", restore-from-text-files());
440  else
441    let filename = locator-name(as(<file-locator>, application-name()));
442    if (split(filename, ".")[0] = "wiki")
443      // This eventually causes process-config-element (above) to be called.
444      http-server-main(description: "Dylan Wiki",
445                       before-startup: initialize-wiki);
446    end;
447  end;
448end function main;
449
450begin
451  main();
452end;
453
454