source: project/release/4/svn-client/trunk/svn-client.scm @ 33980

Last change on this file since 33980 was 33980, checked in by sjamaan, 3 years ago

svn-client: for diff, use revision pegged at working copy head so history can be traced correctly.

File size: 27.6 KB
Line 
1(module svn-client
2  (svn-info? svn-info-url svn-info-repos-root-url
3   svn-info-rev svn-info-last-changed-rev svn-client-info
4
5   svn-file? svn-file-base-path svn-file-path svn-file-kind
6   svn-file-size svn-file-has-props? svn-file-last-changed-revision
7   svn-file-last-changed-time svn-file-last-changed-author
8
9   svn-log? svn-log-message svn-log-author svn-log-date
10   svn-log-revision svn-log-changes
11
12   svn-log-change? svn-log-change-path svn-log-change-action
13   svn-log-change-from-path svn-log-change-from-revision
14
15   make-svn-opt-revision-number svn-opt-revision-head
16   svn-opt-revision-working svn-opt-revision-unspecified
17   svn-opt-revision-number
18
19   svn-commit svn-checkout svn-diff svn-client-list svn-propget
20   svn-propset-local svn-add svn-client-log svn-client-revert
21   svn-client-cat svn-update
22
23   svn-repos-create
24   )
25
26(import chicken scheme foreign)
27(use lolevel)
28
29(foreign-declare "#include \"svn-client-base.c\"")
30
31(define gc-root-ref
32  (foreign-lambda* scheme-object (((c-pointer "void") root))
33    "C_return(CHICKEN_gc_root_ref(root));"))
34
35;;; Pools
36
37(define-record apr-pool ptr)
38
39(define-foreign-type
40  apr-pool-type
41  (c-pointer "apr_pool_t")
42  apr-pool-ptr
43  make-apr-pool)
44
45;;; Hashes
46
47(define-record apr-hash ptr)
48
49(define-foreign-type
50  apr-hash-type
51  (c-pointer "apr_hash_t")
52  apr-hash-ptr
53  make-apr-hash)
54
55;; This is sooo stupid
56(define canonicalize-path-or-url
57  (foreign-lambda nonnull-c-string*
58      "svnclient_canonicalize_path_or_url" nonnull-c-string))
59
60(define-foreign-type svn-path-or-url c-string canonicalize-path-or-url)
61
62;; For svn-strings only
63(define (apr-hash-ref hash key)
64  ((foreign-safe-lambda* c-string ((apr-hash-type hash)
65                                   ((const c-string) key))
66    "svn_string_t *res_s;" ;; How nice that this is so well-documented *COUGH*
67    "if ((res_s = apr_hash_get(hash, key, APR_HASH_KEY_STRING)))"
68    "  C_return(res_s->data);" ;; Can we do this? svn's compat.c sure thinks so!
69    "else"
70    "  C_return(NULL);") hash key))
71
72;;; Errors
73
74(define-record svn-error ptr)
75
76(define-foreign-type
77  svn-error-type
78  (c-pointer "svn_error_t")
79  svn-error-ptr
80  make-svn-error)
81
82(define svn-no-error
83  (foreign-value "SVN_NO_ERROR" svn-error-type))
84
85;;; Info
86
87(define-record svn-info url repos-root-url rev last-changed-rev)
88
89(define-foreign-type
90  svn-info-type
91  (c-pointer "svn_client_info2_t"))
92
93;;; log
94(define-foreign-type
95  svn-log-entry-type
96  (c-pointer "svn_log_entry_t"))
97
98(define svn-log-entry-changed-paths
99  (foreign-lambda* apr-hash-type ((svn-log-entry-type log))
100    "C_return(log->changed_paths);"))
101
102(define svn-log-entry-revision
103  (foreign-lambda* svn-revnum-type ((svn-log-entry-type log))
104    "C_return(log->revision);"))
105
106(define svn-log-entry-revprops
107  (foreign-lambda* apr-hash-type ((svn-log-entry-type log))
108    "C_return(log->revprops);"))
109
110;;; Revisions
111
112(define-record svn-opt-revision ptr)
113
114(define (make-svn-opt-revision-with-finalizer x)
115  (set-finalizer! x free)
116  (make-svn-opt-revision x))
117
118(define-foreign-type
119  svn-opt-revision-type
120  (c-pointer "svn_opt_revision_t")
121  svn-opt-revision-ptr
122  make-svn-opt-revision-with-finalizer)
123
124(define make-svn-opt-revision-number
125  (foreign-lambda* svn-opt-revision-type ((long num))
126    "svn_opt_revision_t *rev = malloc(sizeof(svn_opt_revision_t));"
127    "if (rev) {"
128    "  rev->kind = svn_opt_revision_number;"
129    "  rev->value.number = num;"
130    "}"
131    "C_return(rev);"))
132
133(define svn-opt-revision-head
134  (make-svn-opt-revision
135   (foreign-value "&revision_head" (c-pointer "svn_opt_revision_t"))))
136
137(define svn-opt-revision-working
138  (make-svn-opt-revision
139   (foreign-value "&revision_working" (c-pointer "svn_opt_revision_t"))))
140
141(define svn-opt-revision-unspecified
142  (make-svn-opt-revision
143   (foreign-value "&revision_unspecified" (c-pointer "svn_opt_revision_t"))))
144
145(define svn-opt-revision-number
146  (foreign-lambda* long ((svn-opt-revision-type rev))
147    "C_return(rev->kind == svn_opt_revision_number ? rev->value.number : -1);"))
148
149(define svn-opt-revision-kind
150  (foreign-lambda* unsigned-int ((svn-opt-revision-type rev))
151    "C_return(rev->kind);"))
152
153(define-foreign-type svn-revnum-type long)
154
155;;; svn_log_changed_path_t
156
157(define-record svn-log-changed-path ptr)
158
159(define (make-svn-log-changed-path-with-finalizer x)
160  (set-finalizer! x
161    (foreign-lambda* void (((c-pointer "svn_log_changed_path_t") obj))
162      "if (obj) free(obj);"))
163  (make-svn-log-changed-path x))
164
165(define-foreign-type
166  svn-log-changed-path-type
167  (c-pointer "svn_log_changed_path_t")
168  svn-log-changed-path-ptr
169  make-svn-log-changed-path-with-finalizer)
170
171(define svn-log-changed-path-action
172  (foreign-lambda* char ((svn-log-changed-path-type info))
173    "C_return(info->action);"))
174
175(define svn-log-changed-path-copy-from-path
176  (foreign-lambda* c-string ((svn-log-changed-path-type info))
177    "C_return(info->copyfrom_path);"))
178
179(define svn-log-changed-path-copy-from-rev
180  (foreign-lambda* long ((svn-log-changed-path-type info))
181    "C_return(info->copyfrom_rev);"))
182
183;;; lock
184(define-foreign-type svn-lock-type (c-pointer "svn_lock_t"))
185
186;;; dirent
187(define-foreign-type svn-dirent-type (c-pointer "svn_dirent_t"))
188
189(define svn-dirent-kind
190  (foreign-lambda* (enum "svn_node_kind_t") ((svn-dirent-type dirent))
191    "C_return(dirent->kind);"))
192
193(define svn-dirent-size
194  (foreign-lambda* unsigned-integer64 ((svn-dirent-type dirent))
195    "C_return(dirent->size);"))
196
197(define svn-dirent-has-props?
198  (foreign-lambda* bool ((svn-dirent-type dirent))
199    "C_return(dirent->has_props);"))
200
201(define svn-dirent-created-rev
202  (foreign-lambda* long ((svn-dirent-type dirent))
203    "C_return(dirent->created_rev);"))
204
205(define svn-dirent-time
206  (foreign-lambda* unsigned-integer64 ((svn-dirent-type dirent))
207    "C_return(dirent->time);"))
208
209(define svn-dirent-last-author
210  (foreign-lambda* c-string ((svn-dirent-type dirent))
211    "C_return(dirent->last_author);"))
212
213;;; Depth
214(define-foreign-type svn-depth
215  int
216  (lambda (d)
217    (cond ((boolean? d)
218           (if d
219               (foreign-value "svn_depth_infinity" int)
220               (foreign-value "svn_depth_empty" int)))
221          ((fixnum? d) d)
222          (else (error "Not a correct depth value!")))))
223
224;;; Other stuff
225
226(define svn-commit
227  (foreign-lambda* scheme-object ((c-string path) (svn-depth depth)
228                                  (c-string user) (c-string pass)
229                                  (c-string changes))
230#<<EOF
231  apr_array_header_t *targets = NULL;
232  svn_error_t *err;
233  C_word retval = C_SCHEME_TRUE;
234  apr_pool_t *tmp_pool;
235  tmp_pool = svn_pool_create(NULL);
236
237  targets = apr_array_make(tmp_pool, 1, sizeof(char *));
238
239  (*((const char **) apr_array_push (targets))) = path;
240
241  set_creds_for_next_command(user, pass);
242
243  svn_ctx->log_msg_func = svnwiki_log_callback;
244  svn_ctx->log_msg_baton = changes;
245
246  err = svn_client_commit6(targets, depth, FALSE, FALSE, FALSE,
247                           FALSE, FALSE, NULL, NULL,
248                           svnclient_commit_set_revision,
249                           &retval, svn_ctx, tmp_pool);
250  if (err) {
251    svn_handle_error2(err, stderr, FALSE, "svn: ");
252    svn_error_clear(err);
253    svn_pool_destroy(tmp_pool);
254    C_return(C_SCHEME_FALSE);
255  }
256
257  svn_pool_destroy(tmp_pool);
258  C_return(retval);
259EOF
260))
261
262(define svn-checkout
263  (foreign-lambda* scheme-object ((c-string url) (c-string path)
264                                  (svn-opt-revision-type rev) (svn-depth depth)
265                                  (c-string user) (c-string pass))
266#<<EOF
267  svn_revnum_t revnum;
268  svn_error_t *err;
269  apr_pool_t *tmp_pool;
270  tmp_pool = svn_pool_create(NULL);
271 
272  /* Blergh */
273  svn_opt_revision_t peg_revision;
274  peg_revision.kind = svn_opt_revision_unspecified;
275
276  set_creds_for_next_command(user, pass);
277
278  char const *canonical_url = svn_uri_canonicalize(url, tmp_pool);
279  err = svn_client_checkout3(&revnum, canonical_url, path, &peg_revision,
280                             rev, depth, FALSE, FALSE, svn_ctx, tmp_pool);
281  svn_pool_destroy(tmp_pool);
282  if (err) {
283    svn_handle_error2(err, stderr, FALSE, "svn: ");
284    svn_error_clear(err);
285    C_return(C_SCHEME_FALSE);
286  }
287
288  C_return(C_fix(revnum));
289EOF
290))
291
292(define svn-update
293  (foreign-lambda* scheme-object ((svn-path-or-url path)
294                                  (svn-opt-revision-type rev) (svn-depth depth)
295                                  (c-string user) (c-string pass))
296#<<EOF
297  apr_array_header_t *paths = NULL;
298  svn_error_t *err;
299  apr_pool_t *tmp_pool;
300  tmp_pool = svn_pool_create(NULL);
301
302  set_creds_for_next_command(user, pass);
303
304  paths = apr_array_make(tmp_pool, 1, sizeof(char *));
305  *(char **)apr_array_push(paths) = path;
306 
307  err = svn_client_update4(NULL, paths, rev, depth,
308                           FALSE, FALSE, TRUE, FALSE, TRUE,
309                           svn_ctx, tmp_pool);
310  svn_pool_destroy(tmp_pool);
311  if (err) {
312    svn_handle_error2(err, stderr, FALSE, "svn: ");
313    svn_error_clear(err);
314    C_return(C_SCHEME_FALSE);
315  }
316
317  C_return(C_SCHEME_TRUE);
318EOF
319))
320
321(define svn-diff
322  (foreign-lambda* c-string* ((svn-path-or-url path)
323                              (svn-opt-revision-type rev1)
324                              (svn-opt-revision-type rev2)
325                              (c-string rel_path)
326                              (svn-depth depth)
327                              (c-string user) (c-string pass))
328#<<EOF
329  apr_array_header_t *diff_opts = NULL;
330  char template[] = "/tmp/svnwiki-diff-XXXXXX";
331  apr_file_t *outfile;
332  svn_stream_t *outstream;
333  svn_error_t *err;
334  apr_pool_t *tmp_pool;
335  tmp_pool = svn_pool_create(NULL);
336
337  diff_opts = apr_array_make(tmp_pool, 0, sizeof (char *));
338 
339  apr_file_mktemp(&outfile, template, APR_CREATE|APR_WRITE|APR_EXCL, tmp_pool);
340  outstream = svn_stream_from_aprfile2(outfile, FALSE, tmp_pool);
341 
342  set_creds_for_next_command(user, pass);
343
344  err = svn_client_diff_peg6(diff_opts, path, &revision_working,
345                             rev1, rev2, rel_path, depth, FALSE,
346                             FALSE, FALSE, FALSE, FALSE, FALSE, FALSE,
347                             FALSE, APR_LOCALE_CHARSET,
348                             outstream, NULL, NULL, svn_ctx, tmp_pool);
349  svn_stream_close(outstream);
350  apr_file_close(outfile);
351  if (err) {
352    apr_file_remove(template, tmp_pool);
353    svn_pool_destroy(tmp_pool);
354    svn_handle_error2(err, stderr, FALSE, "svn: ");
355    svn_error_clear(err);
356    C_return(NULL);
357  }
358  svn_pool_destroy(tmp_pool);
359  C_return(strdup(template));
360EOF
361))
362
363(define svn-client-list
364  (foreign-safe-lambda* scheme-object
365      ((svn-path-or-url path) (svn-opt-revision-type rev)
366       (svn-depth depth) (c-string user) (c-string pass))
367#<<EOF
368  void *resultroot;
369  svn_error_t *err;
370  svn_opt_revision_t head;
371  const char *can_path;
372  apr_pool_t *tmp_pool;
373  C_word result;
374  C_word a[C_SIZEOF_PAIR], *ap = a;
375
376  /* Blergh */
377  svn_opt_revision_t peg_revision;
378  peg_revision.kind = svn_opt_revision_unspecified;
379
380  /* (cons #f '()) => updated by set-cdr! in svn_ls_add. cdr is returned */
381  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);
382
383  /* Is this really necessary? */
384  resultroot = CHICKEN_new_gc_root();
385  CHICKEN_gc_root_set(resultroot, result);
386 
387  tmp_pool = svn_pool_create(NULL);
388
389  head.kind = svn_opt_revision_head;
390
391  set_creds_for_next_command(user, pass);
392
393  /* Use DIRENT_ALL? */
394  err = svn_client_list3(path, &peg_revision, rev, depth, SVN_DIRENT_ALL,
395                         TRUE, FALSE, svn_ls_add, resultroot,
396                         svn_ctx, tmp_pool);
397  if (err) {
398    svn_handle_error2(err, stderr, FALSE, "svn: ");
399    svn_error_clear(err);
400    svn_pool_destroy(tmp_pool);
401    CHICKEN_delete_gc_root(resultroot);
402    C_return(C_SCHEME_FALSE);
403  }
404
405  svn_pool_destroy(tmp_pool);
406
407  result = CHICKEN_gc_root_ref(resultroot);
408  CHICKEN_delete_gc_root(resultroot);
409 
410  C_return(revlist(C_u_i_cdr(result)));
411EOF
412))
413
414(define-external (revlist (scheme-object list)) scheme-object (reverse list))
415
416;; We could just pass the dirent around, but doing this copies stuff
417;; to Scheme memory so we can just deallocate the pool when done.
418(define-record svn-file
419  base-path path kind size has-props?
420  last-changed-revision last-changed-time last-changed-author)
421
422(define-external
423  (svn_ls_add ((c-pointer void) baton) ((const c-string) path)
424              ((const svn-dirent-type) dirent) ((const svn-lock-type) lock)
425              ((const c-string) base-path)
426              ((const c-string) external-parent-url)
427              ((const c-string) external-target)
428              (apr-pool-type pool))
429  svn-error-type
430  (let* ((result (gc-root-ref baton))
431         ;; "unused" is to trick the compiler into thinking lock and pool are
432         ;; used, as a workaround for bug #584
433         (unused (list lock pool))
434         (kind (svn-dirent-kind dirent))
435         (kind-symbol (cond
436                       ((= kind (foreign-value "svn_node_none" int)) 'none)
437                       ((= kind (foreign-value "svn_node_file" int)) 'file)
438                       ((= kind (foreign-value "svn_node_dir"  int)) 'directory)
439                       (else 'unknown)))
440         (svn-file (make-svn-file base-path path
441                                  kind-symbol (svn-dirent-size dirent)
442                                  (svn-dirent-has-props? dirent)
443                                  (svn-dirent-created-rev dirent)
444                                  (svn-dirent-time dirent)
445                                  (svn-dirent-last-author dirent))))
446    (set-cdr! result (cons svn-file (cdr result)))
447    svn-no-error))
448
449; Currently returns a list of all property values for a given file.
450(define svn-propget
451  (foreign-safe-lambda* scheme-object ((c-string propname) (c-string target)
452                                       (svn-opt-revision-type rev)
453                                       (svn-depth depth)
454                                       (c-string user) (c-string pass))
455#<<EOF
456  apr_hash_t *props;
457  apr_pool_t *pool;
458  apr_hash_index_t *tmp;
459  svn_error_t *err;
460  void *resultroot;
461  C_word result;
462  C_word a[C_SIZEOF_PAIR], *ap = a;
463
464  /* Blergh */
465  svn_opt_revision_t peg_revision;
466  peg_revision.kind = svn_opt_revision_unspecified;
467 
468  pool = svn_pool_create(NULL);
469 
470  /* (cons #f '()) => updated by set-cdr! in svn_propget_add. cdr is returned */
471  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);
472
473  resultroot = CHICKEN_new_gc_root();
474
475  CHICKEN_gc_root_set(resultroot, result);
476
477  set_creds_for_next_command(user, pass);
478
479  err = svn_client_propget5(&props, NULL, propname, target,
480                            &peg_revision, rev, NULL, depth,
481                            NULL, svn_ctx, pool, pool);
482  if (err) {
483    apr_pool_destroy(pool);
484    svn_handle_error2(err, stderr, FALSE, "svn: ");
485    svn_error_clear(err);
486    C_return(C_SCHEME_FALSE);
487  }
488
489  for (tmp = apr_hash_first(pool, props); tmp; tmp = apr_hash_next(tmp)) {
490    const void *key;
491    apr_ssize_t keylen;
492    svn_string_t *value;
493
494    apr_hash_this(tmp, &key, &keylen, (void **) &value);
495    svn_propget_add(key, value->data, resultroot);
496  }
497
498  apr_pool_destroy(pool);
499
500  result = CHICKEN_gc_root_ref(resultroot);
501  CHICKEN_delete_gc_root(resultroot);
502
503  C_return(revlist(C_u_i_cdr(result)));
504EOF
505))
506
507(define-external (svn_propget_add ((const c-string) key)
508                                  ((const c-string) value)
509                                  ((c-pointer void) baton))
510  void
511  (let ((result (gc-root-ref baton)))
512    (set-cdr! result (cons (list key value) (cdr result)))))
513
514(define svn-propset-local
515  (foreign-safe-lambda* scheme-object ((c-string propname)
516                                       (c-string propval)
517                                       ;; Really just a path
518                                       (svn-path-or-url path)
519                                       (svn-depth depth)
520                                       (bool skip_checks))
521#<<EOF
522  svn_error_t *err;
523  apr_pool_t *tmp_pool;
524  apr_array_header_t *targets;
525  tmp_pool = svn_pool_create(NULL);
526
527  targets = apr_array_make(tmp_pool, 1, sizeof(char *));
528  *(char **)apr_array_push(targets) = path;
529
530  err = svn_client_propset_local(
531          propname, svn_string_create(propval, tmp_pool), /* WHY??? */
532          targets, depth, skip_checks, NULL, svn_ctx, tmp_pool);
533  apr_pool_destroy(tmp_pool);
534  if (err) {
535    svn_handle_error2(err, stderr, FALSE, "svn: ");
536    svn_error_clear(err);
537    C_return(C_SCHEME_FALSE);
538  }
539  C_return(C_SCHEME_TRUE);
540EOF
541))
542
543(define svn-add
544  (foreign-safe-lambda* scheme-object (;; Really just a path
545                                       (svn-path-or-url path)
546                                       (svn-depth depth)
547                                       (c-string user) (c-string pass))
548#<<EOF
549  svn_error_t *err;
550  apr_pool_t *tmp_pool;
551  tmp_pool = svn_pool_create(NULL);
552
553  set_creds_for_next_command(user, pass);
554
555  err = svn_client_add5(path, depth, FALSE, FALSE, FALSE,
556                        FALSE, svn_ctx, tmp_pool);
557  svn_pool_destroy(tmp_pool);
558  if (err) {
559    svn_handle_error2(err, stderr, FALSE, "svn: ");
560    svn_error_clear(err);
561    C_return(C_SCHEME_FALSE);
562  }
563  C_return(C_SCHEME_TRUE);
564EOF
565))
566
567;;; History
568
569(define-record svn-log-change path action from-path from-revision)
570
571(define-external (changed_paths_fix_one ((const c-string) path)
572                                        (svn-log-changed-path-type log-cp)
573                                        ((c-pointer void) root))
574  void
575  (let* ((result (gc-root-ref root))
576         (action (case (svn-log-changed-path-action log-cp)
577                   ((#\A) 'added)
578                   ((#\D) 'deleted)
579                   ((#\R) 'replaced)
580                   ((#\M) 'modified)
581                   (else  'unknown)))
582         (from-path (svn-log-changed-path-copy-from-path log-cp))
583         (from-rev (svn-log-changed-path-copy-from-rev log-cp))
584         (log-change (make-svn-log-change path action from-path from-rev)))
585    (set-cdr! result (cons log-change (cdr result)))))
586
587(define changed-paths-fix
588  (foreign-safe-lambda* scheme-object ((apr-hash-type paths))
589#<<EOF
590  apr_pool_t *tmp_pool;
591  void *resultroot;
592  apr_hash_index_t *tmp;
593  C_word result;
594  C_word a[C_SIZEOF_PAIR], *ap = a;
595
596  if (!paths)
597    C_return(C_SCHEME_END_OF_LIST);
598
599  resultroot = CHICKEN_new_gc_root();
600  /* (cons #f '()) => updated by set-cdr! in changed_paths_fix_one. cdr is returned */
601  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);
602
603  CHICKEN_gc_root_set(resultroot, result);
604
605  tmp_pool = svn_pool_create(NULL);
606
607  for (tmp = apr_hash_first(tmp_pool, paths); tmp; tmp = apr_hash_next(tmp)) {
608    const void *key;
609    void *old;
610    apr_ssize_t keylen;
611    svn_log_changed_path_t *new = malloc(sizeof(svn_log_changed_path_t));
612
613    /* WTF */
614    apr_hash_this(tmp, &key, &keylen, &old);
615
616    *new = * (svn_log_changed_path_t *) old;
617
618    changed_paths_fix_one(key, new, resultroot);
619  }
620  svn_pool_destroy(tmp_pool);
621  result = CHICKEN_gc_root_ref(resultroot);
622  CHICKEN_delete_gc_root(resultroot);
623
624  C_return(revlist(C_u_i_cdr(result)));
625EOF
626))
627
628(define svn-client-log
629  (foreign-safe-lambda* scheme-object ((svn-path-or-url path)
630                                       (svn-opt-revision-type start)
631                                       (svn-opt-revision-type end)
632                                       (int limit)
633                                       (bool discover_changed_paths)
634                                       (bool strict_node_history)
635                                       (c-string user) (c-string pass))
636#<<EOF
637  apr_array_header_t *targets;
638  apr_pool_t *tmp_pool;
639  svn_error_t *err;
640  void *resultroot = CHICKEN_new_gc_root();
641  apr_array_header_t *revprops, *revranges;
642  svn_opt_revision_range_t range;
643  svn_boolean_t include_merged_revs = FALSE;
644  C_word result;
645  C_word a[C_SIZEOF_PAIR], *ap = a;
646 
647  /* Blergh */
648  svn_opt_revision_t peg_revision;
649  peg_revision.kind = svn_opt_revision_unspecified;
650
651  /* (cons #f '()) => updated by set-cdr! in svn_history_add. cdr is returned */
652  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);
653 
654  CHICKEN_gc_root_set(resultroot, result);
655
656  tmp_pool = svn_pool_create(NULL);
657
658  targets = apr_array_make(tmp_pool, 1, sizeof(char *));
659  *(char **)apr_array_push(targets) = path;
660
661  /* These should probably be passed as an argument too */
662  revprops = apr_array_make(tmp_pool, 3, sizeof(char *));
663  APR_ARRAY_PUSH(revprops, char *) = "svn:author";
664  APR_ARRAY_PUSH(revprops, char *) = "svn:date";
665  APR_ARRAY_PUSH(revprops, char *) = "svn:log";
666
667  set_creds_for_next_command(user, pass);
668
669  range.start = *start;
670  range.end = *end;
671
672  revranges = apr_array_make(tmp_pool, 1, sizeof(svn_opt_revision_range_t *));
673  APR_ARRAY_PUSH(revranges, svn_opt_revision_range_t *) = &range;
674
675  err = svn_client_log5(targets, &peg_revision, revranges, limit,
676                                 discover_changed_paths, strict_node_history,
677                                 include_merged_revs, revprops, svn_history_add,
678                                 (void *) resultroot, svn_ctx, tmp_pool);
679
680  svn_pool_destroy(tmp_pool);
681  if (err) {
682    CHICKEN_delete_gc_root(resultroot);
683    svn_handle_error2(err, stderr, FALSE, "svn: ");
684    svn_error_clear(err);
685    C_return(C_SCHEME_FALSE);
686  }
687
688  result = CHICKEN_gc_root_ref(resultroot);
689  CHICKEN_delete_gc_root(resultroot);
690 
691  C_return(C_u_i_cdr(result));
692EOF
693))
694
695;; We could just pass the log entry around, but doing this copies stuff
696;; to Scheme memory so we can just deallocate the pool when done.
697(define-record svn-log message author date changes revision)
698
699(define-external (svn_history_add ((c-pointer void) baton)
700                                  (svn-log-entry-type entry)
701                                  (apr-pool-type pool))
702  svn-error-type
703  (let* ((result (gc-root-ref baton))
704         (paths (changed-paths-fix (svn-log-entry-changed-paths entry)))
705         (h (svn-log-entry-revprops entry))
706         (svn-log (make-svn-log (apr-hash-ref h "svn:log")
707                                (apr-hash-ref h "svn:author")
708                                (apr-hash-ref h "svn:date")
709                                paths
710                                (svn-log-entry-revision entry))))
711    (set-cdr! result (cons svn-log (cdr result)))
712    svn-no-error))
713
714(define get-lock
715  (foreign-lambda* scheme-object ((c-string path))
716#<<EOF
717  int fd;
718  mkdir(path, S_IRWXU);
719  if ((fd = open(path, O_RDONLY)) == -1 || flock(fd, LOCK_EX) == -1) {
720    fprintf(stderr, "%s: %s\n", path, strerror(errno));
721    exit(EXIT_FAILURE);
722  }
723  return C_SCHEME_TRUE;
724EOF
725))
726
727(define svn-time-from-cstring
728  (foreign-lambda* number ((c-string data))
729#<<EOF
730  apr_time_t when;
731  apr_pool_t *tmp_pool;
732  tmp_pool = svn_pool_create(NULL);
733  svn_time_from_cstring(&when, data, tmp_pool);
734  apr_pool_destroy(tmp_pool);
735  C_return((double) when);
736EOF
737))
738
739(define svn-client-revert
740  (foreign-safe-lambda* bool ((scheme-object paths) (svn-depth depth)
741                              (c-string user) (c-string pass))
742#<<EOF
743  apr_pool_t *tmp_pool;
744  apr_array_header_t *paths_array;
745  svn_error_t *err;
746  C_word tmp;
747  int len = 0;
748
749  tmp_pool = svn_pool_create(NULL);
750
751  for (tmp = paths; C_i_pairp(tmp) && tmp != C_SCHEME_END_OF_LIST; tmp = C_u_i_cdr(tmp))
752    len ++;
753
754  paths_array = apr_array_make(tmp_pool, len, sizeof(char *));
755
756  for (tmp = paths; C_i_pairp(tmp) && tmp != C_SCHEME_END_OF_LIST; tmp = C_u_i_cdr(tmp)) {
757    int len = C_header_size(C_u_i_car(tmp));
758    char *buffer = apr_palloc(tmp_pool, len + 1);
759
760    strncpy(buffer, C_c_string(C_u_i_car(tmp)), len);
761    buffer[len] = 0;
762
763    (*((const char **) apr_array_push(paths_array))) = buffer;
764  }
765
766  set_creds_for_next_command(user, pass);
767
768  err = svn_client_revert2(paths_array, depth, NULL, svn_ctx, tmp_pool);
769
770  apr_pool_destroy(tmp_pool);
771
772  if (err) {
773    svn_handle_error2(err, stderr, FALSE, "svn: ");
774    svn_error_clear(err);
775    C_return(C_SCHEME_FALSE);
776  }
777
778  C_return(C_SCHEME_TRUE);
779EOF
780))
781
782(define svn-client-cat
783  (foreign-safe-lambda* c-string* ((svn-path-or-url path_or_url)
784                                   (svn-opt-revision-type revision)
785                                   (c-string user) (c-string pass))
786#<<EOF
787  apr_array_header_t *diff_opts = NULL;
788  char template[] = "/tmp/svnwiki-cat-XXXXXX";
789  apr_file_t *outfile;
790  svn_stream_t *out;
791  apr_pool_t *tmp_pool;
792  svn_opt_revision_t head;
793
794  apr_file_t *stdout_file;
795  svn_error_t *err;
796
797  tmp_pool = svn_pool_create(NULL);
798
799  diff_opts = apr_array_make(tmp_pool, 0, sizeof (char *));
800
801  apr_file_mktemp(&outfile, template, APR_CREATE | APR_WRITE | APR_EXCL, tmp_pool);
802  out = svn_stream_from_aprfile2(outfile, FALSE, tmp_pool);
803
804  set_creds_for_next_command(user, pass);
805
806  head.kind = svn_opt_revision_unspecified;
807  err = svn_client_cat2(out, path_or_url, &head, revision, svn_ctx, tmp_pool);
808  if (err) {
809    svn_stream_close(out);
810    apr_file_remove(template, tmp_pool);
811    apr_pool_destroy(tmp_pool);
812    svn_handle_error2(err, stderr, FALSE, "svn: ");
813    svn_error_clear(err);
814    C_return(NULL);
815  }
816
817  svn_stream_close(out);
818  apr_pool_destroy(tmp_pool);
819
820  C_return(strdup(template));
821EOF
822))
823
824(define svn-client-info
825  (foreign-safe-lambda* void ((svn-path-or-url abspath_or_url)
826                              (svn-opt-revision-type peg_revision)
827                              (svn-opt-revision-type revision) (svn-depth depth)
828                              (c-string user) (c-string pass))
829#<<EOF
830  void *resultroot;
831
832  apr_hash_t *props;
833  apr_pool_t *tmp_pool;
834  svn_opt_revision_t head;
835  apr_hash_index_t *tmp;
836  svn_error_t *err;
837  C_word result;
838  C_word a[C_SIZEOF_PAIR], *ap = a;
839
840  tmp_pool = svn_pool_create(NULL);
841
842  /* (cons #f '()) => updated by set-cdr! in svn_client_info_receiver. cdr is returned */
843  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);
844 
845  resultroot = CHICKEN_new_gc_root();
846  CHICKEN_gc_root_set(resultroot, result);
847
848  set_creds_for_next_command(user, pass);
849
850  err = svn_client_info3(abspath_or_url, peg_revision, revision,
851                         depth, TRUE, TRUE, NULL,
852                         svn_client_info_receiver, resultroot,
853                         svn_ctx, tmp_pool);
854  if (err) {
855    apr_pool_destroy(tmp_pool);
856    svn_handle_error2(err, stderr, FALSE, "svn: ");
857    svn_error_clear(err);
858    CHICKEN_delete_gc_root(resultroot);
859    C_return(C_SCHEME_FALSE);
860  }
861
862  apr_pool_destroy(tmp_pool);
863
864  result = CHICKEN_gc_root_ref(resultroot);
865  CHICKEN_delete_gc_root(resultroot);
866
867  C_return(revlist(C_u_i_cdr(result)));
868EOF
869))
870
871(define-external (svn_client_info_receiver ((c-pointer void) baton)
872                                           ((const c-string) path-or-url)
873                                           ((const svn-info-type) info)
874                                           (apr-pool-type scratch-pool))
875  svn-error-type
876  (let ((result (gc-root-ref baton)))
877    (set-cdr! result
878              (cons (list path-or-url
879                          (make-svn-info
880                           ((foreign-lambda* c-string ((svn-info-type info))
881                                             "C_return(info->URL);") info)
882                           ((foreign-lambda* c-string ((svn-info-type info))
883                                             "C_return(info->repos_root_URL);") info)
884                           ((foreign-lambda* long ((svn-info-type info))
885                                             "C_return(info->rev);") info)
886                           ((foreign-lambda* long ((svn-info-type info))
887                                             "C_return(info->last_changed_rev);") info)))
888                    (cdr result)))
889    svn-no-error))
890
891
892(define svn-repos-create
893  (foreign-lambda* scheme-object ((nonnull-c-string path)) #<<EOF
894  apr_pool_t *tmp_pool;
895  svn_error_t *err;
896  svn_repos_t *repos_p;
897
898  tmp_pool = svn_pool_create(NULL);
899  err = svn_repos_create (&repos_p, path, NULL, NULL, NULL, NULL, tmp_pool);
900  svn_pool_destroy(tmp_pool);
901  if (err) {
902    svn_handle_error2(err, stderr, FALSE, "svn: ");
903    svn_error_clear(err);
904    C_return(C_SCHEME_FALSE);
905  }
906  C_return(C_SCHEME_TRUE);
907EOF
908))
909
910;;; Init
911
912((foreign-lambda void "chicken_svn_client_lib_initialize"))
913
914)
Note: See TracBrowser for help on using the repository browser.