source: project/release/3/svn-client/trunk/svn-client.scm @ 12509

Last change on this file since 12509 was 12509, checked in by azul, 11 years ago

Adding implementation for svn-propset.

File size: 20.2 KB
Line 
1(declare (foreign-declare #<<EOF
2#include <apr.h>
3#include <apr_hash.h>
4#include <apr_file_io.h>
5#include <apr_pools.h>
6#include <svn_auth.h>
7#include <svn_client.h>
8#include <svn_path.h>
9#include <svn_pools.h>
10#include <svn_config.h>
11#include <sys/file.h>
12#include <sys/stat.h>
13#include <sys/types.h>
14#include <unistd.h>
15#include <errno.h>
16
17static svn_opt_revision_t revision_head;
18static svn_opt_revision_t revision_unspecified;
19
20char *svnwiki_user, *svnwiki_pass;
21apr_pool_t *svn_pool;
22svn_client_ctx_t *svn_ctx;
23
24svn_error_t *
25svnwiki_simple_first_credentials (void **credentials, void **iter_baton, void *provider_baton, apr_hash_t *parameters, const char *realmstring, apr_pool_t *pool)
26{
27  svn_auth_cred_simple_t *cred;
28  *credentials = cred = apr_pcalloc(pool, sizeof(svn_auth_cred_simple_t));
29  cred->username = svnwiki_user;
30  cred->password = svnwiki_pass;
31  cred->may_save = 0;
32  return 0;
33}
34
35svn_error_t *
36svnwiki_username_first_credentials (void **credentials, void **iter_baton, void *provider_baton, apr_hash_t *parameters, const char *realmstring, apr_pool_t *pool)
37{
38  svn_auth_cred_username_t *cred;
39  *credentials = cred = apr_pcalloc(pool, sizeof(svn_auth_cred_simple_t));
40  cred->username = svnwiki_user;
41  cred->may_save = 0;
42  return 0;
43}
44
45svn_error_t *
46svnwiki_log_callback (const char **log_msg, const char **tmp_file, apr_array_header_t *commit_items, void *baton, apr_pool_t *pool)
47{
48  *tmp_file = NULL;
49  *log_msg = baton;
50  return SVN_NO_ERROR;
51}
52
53svn_auth_provider_t svnwiki_auth_simple   = { SVN_AUTH_CRED_SIMPLE, svnwiki_simple_first_credentials, NULL, NULL };
54svn_auth_provider_object_t svnwiki_auth_simple_obj = { &svnwiki_auth_simple, NULL };
55
56svn_auth_provider_t svnwiki_auth_username = { SVN_AUTH_CRED_USERNAME, svnwiki_username_first_credentials, NULL, NULL };
57svn_auth_provider_object_t svnwiki_auth_username_obj = { &svnwiki_auth_username, NULL };
58EOF
59))
60
61;;; Pools
62
63(define-record apr-pool ptr)
64
65(define-foreign-type
66  apr-pool-type
67  (pointer "apr_pool_t")
68  apr-pool-ptr
69  make-apr-pool)
70
71(define svn-pool-create
72  (foreign-lambda apr-pool-type "svn_pool_create" apr-pool-type))
73
74;;; Hashes
75
76(define-record apr-hash ptr)
77
78(define-foreign-type
79  apr-hash-type
80  (pointer "apr_hash_t")
81  apr-hash-ptr
82  make-apr-hash)
83
84(define-record apr-hash-index ptr)
85
86(define-foreign-type
87  apr-hash-index-type
88  (pointer "apr_hash_index_t")
89  apr-hash-index-ptr
90  make-apr-hash-index)
91
92(define apr-hash-first
93  (foreign-lambda* apr-hash-index-type ((apr-hash-type hash))
94  "return(apr_hash_first(svn_pool, hash));"))
95
96(define apr-hash-next
97  (foreign-lambda* apr-hash-index-type ((apr-hash-index-type index)) #<<EOF
98  return(apr_hash_next(index));
99EOF
100))
101  ;(foreign-lambda apr-hash-index-type "apr_hash_next" apr-hash-index-type))
102
103(define-external (apr_hash_this_inner ((pointer void) key) (long len) ((pointer void) value)) scheme-object
104  (list key len value))
105
106(define apr-hash-this
107  (foreign-lambda* void ((apr-hash-index-type index)) #<<EOF
108  const void *key;
109  apr_ssize_t keylen;
110  void *value;
111  apr_hash_this(index, &key, &keylen, &value);
112  return(apr_hash_this_inner(key, keylen, value));
113EOF
114))
115
116;;; Errors
117
118(define-record svn-error ptr)
119
120(define-foreign-type
121  svn-error-type
122  (pointer "svn_error_t")
123  svn-error-ptr
124  make-svn-error)
125
126(define svn-no-error
127  (foreign-value "SVN_NO_ERROR" svn-error-type))
128
129;;; Init
130
131((foreign-lambda* c-pointer () #<<EOF
132  apr_array_header_t *providers;
133
134  apr_initialize();
135  svn_pool = svn_pool_create(NULL);
136  svn_config_ensure(NULL, svn_pool);
137
138  svn_client_create_context(&svn_ctx, svn_pool);
139  svn_config_get_config(&svn_ctx->config, NULL, svn_pool);
140
141  providers = apr_array_make(svn_pool, 2, sizeof(svn_auth_provider_object_t *));
142
143  *(svn_auth_provider_object_t **)apr_array_push(providers) = &svnwiki_auth_simple_obj;
144  *(svn_auth_provider_object_t **)apr_array_push(providers) = &svnwiki_auth_username_obj;
145
146  svn_auth_open(&svn_ctx->auth_baton, providers, svn_pool);
147
148  revision_head.kind = svn_opt_revision_head;
149  revision_unspecified.kind = svn_opt_revision_unspecified;
150
151  return(NULL);
152EOF
153))
154
155;;; Info
156
157(define-record svn-info ptr)
158
159;(define (make-svn-info-with-finalizer x)
160;  (set-finalizer! x (foreign-lambda void "free" (pointer "svn_info_t")))
161;  (make-svn-info x))
162
163(define-foreign-type
164  svn-info-type
165  (pointer "svn_info_t")
166  svn-info-ptr
167  ;make-svn-info-with-finalizer)
168  make-svn-info)
169
170(define svn-info-url
171  (foreign-lambda* c-string ((svn-info-type info))
172#<<EOF
173  return(info->URL);
174EOF
175))
176
177(define svn-info-repos-root-url
178  (foreign-lambda* c-string ((svn-info-type info))
179#<<EOF
180  return(info->repos_root_URL);
181EOF
182))
183
184(define svn-info-rev
185  (foreign-lambda* long ((svn-info-type info))
186#<<EOF
187  return(info->rev);
188EOF
189))
190
191;;; Revisions
192
193(define-record svn-opt-revision ptr)
194
195(define (make-svn-opt-revision-with-finalizer x)
196  (set-finalizer! x (foreign-lambda void "free" (pointer "svn_opt_revision_t")))
197  (make-svn-opt-revision x))
198
199(define-foreign-type
200  svn-opt-revision-type
201  (pointer "svn_opt_revision_t")
202  svn-opt-revision-ptr
203  make-svn-opt-revision-with-finalizer)
204
205(define make-svn-opt-revision-number
206  (foreign-lambda* svn-opt-revision-type ((long num))
207#<<EOF
208  svn_opt_revision_t *rev = malloc(sizeof(svn_opt_revision_t));
209  if (rev)
210    {
211      rev->kind = svn_opt_revision_number;
212      rev->value.number = num;
213    }
214  return(rev);
215EOF
216))
217
218(define svn-opt-revision-head
219  (make-svn-opt-revision (foreign-value "&revision_head" (pointer "svn_opt_revision_t"))))
220
221(define svn-opt-revision-unspecified
222  (make-svn-opt-revision (foreign-value "&revision_unspecified" (pointer "svn_opt_revision_t"))))
223
224(define svn-opt-revision-number
225  (foreign-lambda* long ((svn-opt-revision-type rev))
226#<<EOF
227  return(rev->kind == svn_opt_revision_number ? rev->value.number : -1);
228EOF
229))
230
231(define svn-opt-revision-kind
232  (foreign-lambda* unsigned-int ((svn-opt-revision-type rev))
233#<<EOF
234  return(rev->kind);
235EOF
236))
237
238(define-foreign-type svn-revnum-type long)
239
240;;; svn_log_changed_path_t
241
242(define-record svn-log-changed-path ptr)
243
244(define (make-svn-log-changed-path-with-finalizer x)
245  (set-finalizer! x
246    (foreign-lambda* void (((pointer "svn_log_changed_path_t") obj))
247      "if (obj) free(obj->copyfrom_path); free(obj);"))
248  (make-svn-log-changed-path x))
249
250(define-foreign-type
251  svn-log-changed-path-type
252  (pointer "svn_log_changed_path_t")
253  svn-log-changed-path-ptr
254  make-svn-log-changed-path-with-finalizer)
255
256(define svn-log-changed-path-action
257  (foreign-lambda* char ((svn-log-changed-path-type info))
258#<<EOF
259    return(info->action);
260EOF
261))
262
263(define svn-log-changed-path-copy-from-path
264  (foreign-lambda* c-string ((svn-log-changed-path-type info))
265#<<EOF
266    return(info->copyfrom_path);
267EOF
268))
269
270(define svn-log-changed-path-copy-from-rev
271  (foreign-lambda* long ((svn-log-changed-path-type info))
272#<<EOF
273    return(info->copyfrom_rev);
274EOF
275))
276
277;;; Other stuff
278
279(define svn-commit
280  (foreign-lambda* scheme-object ((c-string path) (c-string user) (c-string pass) (c-string changes))
281#<<EOF
282  svn_client_commit_info_t *commit_info = NULL;
283  apr_array_header_t *targets = apr_array_make(svn_pool, 1, sizeof(char *));
284  svn_error_t *err;
285
286  (*((const char **) apr_array_push (targets))) = path;
287
288  svnwiki_user = user;
289  svnwiki_pass = pass;
290
291  svn_ctx->log_msg_func = svnwiki_log_callback;
292  svn_ctx->log_msg_baton = changes;
293
294  err = svn_client_commit(&commit_info, targets, FALSE, svn_ctx, svn_pool);
295  if (err)
296    {
297      svn_handle_error(err, stderr, FALSE);
298      svn_error_clear(err);
299      return(C_SCHEME_FALSE);
300    }
301  if (!commit_info || commit_info->revision == SVN_INVALID_REVNUM)
302    return(C_SCHEME_TRUE);
303  return(C_fix(commit_info->revision));
304EOF
305))
306
307(define svn-update
308  (foreign-lambda* scheme-object ((c-string url) (c-string path) (svn-opt-revision-type rev) (c-string user) (c-string pass))
309#<<EOF
310  svn_revnum_t revnum;
311  svn_error_t *err;
312
313  svnwiki_user = user;
314  svnwiki_pass = pass;
315
316  err = svn_client_checkout(&revnum, url, path, rev, TRUE, svn_ctx, svn_pool);
317  if (err)
318    {
319      svn_handle_error(err, stderr, FALSE);
320      svn_error_clear(err);
321      return(C_SCHEME_FALSE);
322    }
323
324  return(C_fix(revnum));
325EOF
326))
327
328(define svn-diff
329  (foreign-lambda* c-string* ((c-string path) (c-string user) (c-string pass))
330#<<EOF
331  apr_array_header_t *diff_opts = apr_array_make(svn_pool, 0, sizeof (char *));
332  char template[] = "/tmp/svnwiki-diff-XXXXXX";
333  svn_opt_revision_t rev1, rev2;
334  apr_file_t *outfile;
335  svn_error_t *err;
336
337  svnwiki_user = user;
338  svnwiki_pass = pass;
339
340  rev1.kind = svn_opt_revision_head;
341  rev2.kind = svn_opt_revision_working;
342
343  mkstemp(template);
344  apr_file_open(&outfile, template, APR_WRITE, APR_OS_DEFAULT, svn_pool);
345  err = svn_client_diff(diff_opts, path, &rev1, path, &rev2, TRUE, FALSE, TRUE, outfile, NULL, svn_ctx, svn_pool);
346  if (err)
347    {
348      svn_handle_error(err, stderr, FALSE);
349      svn_error_clear(err);
350      return(NULL);
351    }
352  apr_file_close(outfile);
353  return(strdup(template));
354EOF
355))
356
357(define svn-ls
358  (foreign-safe-lambda* scheme-object ((c-string path) (scheme-object result) (c-string user) (c-string pass))
359#<<EOF
360  svn_error_t *err;
361  apr_hash_t *dirents;
362  apr_hash_index_t *tmp;
363  svn_opt_revision_t head;
364  const char *can_path = svn_path_internal_style(path, svn_pool);
365
366  head.kind = svn_opt_revision_head;
367
368  svnwiki_user = user;
369  svnwiki_pass = pass;
370
371  err = svn_client_ls(&dirents, can_path, &head, FALSE, svn_ctx, svn_pool);
372  if (err)
373    {
374      svn_handle_error(err, stderr, FALSE);
375      svn_error_clear(err);
376      return(C_SCHEME_FALSE);
377    }
378
379  for (tmp = apr_hash_first(svn_pool, dirents); tmp; tmp = apr_hash_next(tmp))
380    {
381      const void *key;
382      apr_ssize_t keylen;
383      svn_dirent_t *value;
384
385      apr_hash_this(tmp, &key, &keylen, (void **) &value);
386      result = svn_ls_add(key,
387                          value->kind == svn_node_file ? C_fix(value->size) : C_SCHEME_FALSE,
388                          value->created_rev,
389                          result);
390    }
391
392  return(result);
393EOF
394))
395
396(define-external (svn_ls_add (c-string key) (scheme-object size) (long rev) (scheme-object result)) scheme-object
397  (cons (list key size rev) result))
398
399; Currently returns a list of all property values for a given file.
400
401(define svn-propget
402  (foreign-safe-lambda* scheme-object ((c-string propname) (c-string target) (c-string user) (c-string pass) (scheme-object result))
403#<<EOF
404  apr_hash_t *props;
405  apr_pool_t *pool;
406  svn_opt_revision_t head;
407  apr_hash_index_t *tmp;
408  svn_error_t *err;
409  void *resultroot;
410
411  head.kind = svn_opt_revision_unspecified;
412
413  svnwiki_user = user;
414  svnwiki_pass = pass;
415
416  pool = svn_pool_create(NULL);
417
418  resultroot = CHICKEN_new_gc_root();
419
420  CHICKEN_gc_root_set(resultroot, result);
421
422  err = svn_client_propget(&props, propname, target, &head, FALSE, svn_ctx, pool);
423  if (err)
424    {
425      apr_pool_destroy(pool);
426      svn_handle_error(err, stderr, FALSE);
427      svn_error_clear(err);
428      return(C_SCHEME_FALSE);
429    }
430
431  for (tmp = apr_hash_first(pool, props); tmp; tmp = apr_hash_next(tmp))
432    {
433      const void *key;
434      apr_ssize_t keylen;
435      svn_string_t *value;
436
437      apr_hash_this(tmp, &key, &keylen, (void **) &value);
438      CHICKEN_gc_root_set(resultroot, svn_propget_add(key, value->data, resultroot));
439    }
440
441  apr_pool_destroy(pool);
442
443  result = CHICKEN_gc_root_ref(resultroot);
444  CHICKEN_delete_gc_root(resultroot);
445
446  return(result);
447EOF
448))
449
450(define-external (svn_propget_add (c-string key) (c-string value) ((pointer void) result)) scheme-object
451  (cons (list key value) (gc-root-ref result)))
452
453(define svn-propset
454  (foreign-safe-lambda* scheme-object ((c-string propname)
455                                       (c-string propval)
456                                       (c-string target)
457                                       (bool recurse)
458                                       (bool skip_checks))
459#<<EOF
460  svn_error_t *err;
461  apr_pool_t *pool;
462
463  pool = svn_pool_create(NULL);
464  err = svn_client_propset2(propname, svn_string_create(propval, pool), target, recurse, skip_checks, svn_ctx, pool);
465  apr_pool_destroy(pool);
466  if (err)
467    {
468      svn_handle_error(err, stderr, FALSE);
469      svn_error_clear(err);
470      return(C_SCHEME_FALSE);
471    }
472  return(C_SCHEME_TRUE);
473EOF
474))
475
476(define svn-add
477  (foreign-safe-lambda* scheme-object ((c-string path))
478#<<EOF
479  svn_error_t *err;
480  err = svn_client_add(path, 0, svn_ctx, svn_pool);
481  if (err)
482    {
483      svn_handle_error(err, stderr, FALSE);
484      svn_error_clear(err);
485      return(C_SCHEME_FALSE);
486    }
487  return(C_SCHEME_TRUE);
488EOF
489))
490
491;;; History
492
493(define gc-root-ref
494  (foreign-lambda* void (((pointer "void") root)) "return(CHICKEN_gc_root_ref(root));"))
495
496(define-external (svn_history_add ((pointer void) root) (apr-hash-type changed-paths) (svn-revnum-type rev) (c-string author) (c-string date) (c-string message) (apr-pool-type pool)) svn-error-type
497  (let ((paths (changed-paths-fix changed-paths '())))
498    ((gc-root-ref root) paths rev author date message))
499  svn-no-error)
500
501(define-external (changed_paths_fix_one (c-string key) (svn-log-changed-path-type log-cp) ((pointer void) root)) scheme-object
502  (cons (cons key log-cp) (gc-root-ref root)))
503
504(define changed-paths-fix
505  (foreign-safe-lambda* scheme-object ((apr-hash-type paths) (scheme-object result)) #<<EOF
506  apr_pool_t *pool;
507  void *resultroot;
508  apr_hash_index_t *tmp;
509
510  if (!paths)
511    return(result);
512
513  resultroot = CHICKEN_new_gc_root();
514
515  CHICKEN_gc_root_set(resultroot, result);
516
517  pool = svn_pool_create(NULL);
518
519  for (tmp = apr_hash_first(pool, paths); tmp; tmp = apr_hash_next(tmp))
520    {
521      const void *key;
522      void *old;
523      apr_ssize_t keylen;
524      svn_log_changed_path_t *new = malloc(sizeof(svn_log_changed_path_t));
525
526      apr_hash_this(tmp, &key, &keylen, &old);
527
528      *new = * (svn_log_changed_path_t *) old;
529
530      if (new->copyfrom_path)
531        new->copyfrom_path = strdup(new->copyfrom_path);
532
533      CHICKEN_gc_root_set(resultroot, changed_paths_fix_one(key, new, resultroot));
534    }
535  apr_pool_destroy(pool);
536  result = CHICKEN_gc_root_ref(resultroot);
537  CHICKEN_delete_gc_root(resultroot);
538
539  return(result);
540EOF
541))
542
543(define svn-client-log2
544  (foreign-safe-lambda* bool ((c-string path) (svn-opt-revision-type start) (svn-opt-revision-type end) (int limit) (bool discover_changed_paths) (bool strict_node_history) (c-string user) (c-string pass) (scheme-object func))
545#<<EOF
546  apr_array_header_t *targets;
547  apr_pool_t *pool;
548  svn_error_t *err;
549  void *funcroot = CHICKEN_new_gc_root();
550
551  CHICKEN_gc_root_set(funcroot, func);
552
553  pool = svn_pool_create(NULL);
554
555  targets = apr_array_make(pool, 1, sizeof(char *));
556
557  *(char **)apr_array_push(targets) = path;
558
559  svnwiki_user = user;
560  svnwiki_pass = pass;
561
562  err = svn_client_log2(targets, start, end, limit, discover_changed_paths, strict_node_history, svn_history_add, (void *) funcroot, svn_ctx, pool);
563
564  apr_pool_destroy(pool);
565  CHICKEN_delete_gc_root(funcroot);
566
567  if (err)
568    {
569      svn_handle_error(err, stderr, FALSE);
570      svn_error_clear(err);
571      return(C_SCHEME_FALSE);
572    }
573
574  return(C_SCHEME_TRUE);
575EOF
576))
577
578; Currently returns a list with an entry for each commit between start and end.
579; Each entry is itself a list with the commit message, the number of the
580; revision that was created as the result of the commit, the author, the date
581; of the commit (a string) and the list of changed files.
582
583(define svn-client-log
584  (foreign-safe-lambda* bool ((c-string path) (svn-opt-revision-type start) (svn-opt-revision-type end) (bool discover_changed_paths) (bool strict_node_history) (c-string user) (c-string pass) (scheme-object func))
585#<<EOF
586  apr_array_header_t *targets;
587  apr_pool_t *pool;
588  svn_error_t *err;
589  void *funcroot = CHICKEN_new_gc_root();
590
591  CHICKEN_gc_root_set(funcroot, func);
592
593  pool = svn_pool_create(NULL);
594
595  targets = apr_array_make(pool, 1, sizeof(char *));
596
597  *(char **)apr_array_push(targets) = path;
598
599  svnwiki_user = user;
600  svnwiki_pass = pass;
601
602  err = svn_client_log(targets, start, end, discover_changed_paths, strict_node_history, svn_history_add, (void *) funcroot, svn_ctx, pool);
603
604  apr_pool_destroy(pool);
605  CHICKEN_delete_gc_root(funcroot);
606
607  if (err)
608    {
609      svn_handle_error(err, stderr, FALSE);
610      svn_error_clear(err);
611      return(C_SCHEME_FALSE);
612    }
613
614  return(C_SCHEME_TRUE);
615EOF
616))
617
618(define get-lock
619  (foreign-lambda* scheme-object ((c-string path))
620#<<EOF
621  int fd;
622  mkdir(path, S_IRWXU);
623  if ((fd = open(path, O_RDONLY)) == -1 || flock(fd, LOCK_EX) == -1)
624    {
625      fprintf(stderr, "%s: %s\n", path, strerror(errno));
626      exit(EXIT_FAILURE);
627    }
628  return C_SCHEME_TRUE;
629EOF
630))
631
632(define svn-time-from-cstring
633  (foreign-lambda* number ((c-string data))
634#<<EOF
635  apr_time_t when;
636  apr_pool_t *pool;
637  pool = svn_pool_create(NULL);
638  svn_time_from_cstring(&when, data, pool);
639  apr_pool_destroy(pool);
640  return((double) when);
641EOF
642))
643
644(define svn-client-revert
645  (foreign-safe-lambda* bool ((scheme-object paths) (bool recursive) (c-string user) (c-string pass))
646#<<EOF
647  apr_pool_t *pool;
648  apr_array_header_t *paths_array;
649  svn_error_t *err;
650  C_word tmp;
651  int len = 0;
652
653  pool = svn_pool_create(NULL);
654
655  for (tmp = paths; C_i_pairp(tmp) && tmp != C_SCHEME_END_OF_LIST; tmp = C_u_i_cdr(tmp))
656    len ++;
657
658  paths_array = apr_array_make(pool, len, sizeof(char *));
659
660  for (tmp = paths; C_i_pairp(tmp) && tmp != C_SCHEME_END_OF_LIST; tmp = C_u_i_cdr(tmp))
661    {
662      int len = C_header_size(C_u_i_car(tmp));
663      char *buffer = apr_palloc(svn_pool, len + 1);
664
665      strncpy(buffer, C_c_string(C_u_i_car(tmp)), len);
666      buffer[len] = 0;
667
668      (*((const char **) apr_array_push(paths_array))) = buffer;
669    }
670
671  err = svn_client_revert(paths_array, recursive, svn_ctx, pool);
672
673  apr_pool_destroy(pool);
674
675  if (err)
676    {
677      svn_handle_error(err, stderr, FALSE);
678      svn_error_clear(err);
679      return(C_SCHEME_FALSE);
680    }
681
682  return(C_SCHEME_TRUE);
683EOF
684))
685
686(define svn-client-resolved
687  (foreign-safe-lambda* bool ((c-string path) (bool recursive))
688#<<EOF
689  apr_pool_t *pool;
690  svn_error_t *err;
691
692  pool = svn_pool_create(NULL);
693
694  err = svn_client_resolved(path, recursive, svn_ctx, pool);
695
696  apr_pool_destroy(pool);
697
698  if (err)
699    {
700      svn_handle_error(err, stderr, FALSE);
701      svn_error_clear(err);
702      return(C_SCHEME_FALSE);
703    }
704
705  return(C_SCHEME_TRUE);
706 
707EOF
708))
709
710(define svn-path-canonicalize
711  (foreign-safe-lambda* c-string ((c-string old))
712#<<EOF
713  apr_pool_t *pool;
714  char *new;
715
716  pool = svn_pool_create(NULL);
717
718  new = strdup(svn_path_canonicalize(old, pool));
719
720  apr_pool_destroy(pool);
721
722  return(new);
723EOF
724))
725
726(define svn-client-cat
727  (foreign-safe-lambda* c-string* ((c-string path_or_url) (svn-opt-revision-type revision) (c-string user) (c-string pass))
728#<<EOF
729  apr_array_header_t *diff_opts = apr_array_make(svn_pool, 0, sizeof (char *));
730  char template[] = "/tmp/svnwiki-cat-XXXXXX";
731  apr_file_t *outfile;
732  svn_stream_t *out;
733  apr_pool_t *pool;
734
735  apr_file_t *stdout_file;
736  svn_error_t *err;
737
738  svnwiki_user = user;
739  svnwiki_pass = pass;
740
741  pool = svn_pool_create(NULL);
742
743  mkstemp(template);
744
745  apr_file_open(&outfile, template, APR_WRITE, APR_OS_DEFAULT, pool);
746  out = svn_stream_from_aprfile(outfile, pool);
747
748  err = svn_client_cat(out, path_or_url, revision, svn_ctx, pool);
749  if (err)
750    {
751      apr_pool_destroy(pool);
752      svn_handle_error(err, stderr, FALSE);
753      svn_error_clear(err);
754      return(NULL);
755    }
756
757  svn_stream_close(out);
758  apr_pool_destroy(pool);
759
760  return(strdup(template));
761EOF
762))
763
764(define svn-client-info
765  (foreign-safe-lambda* void ((c-string path_or_url) (svn-opt-revision-type peg_revision) (svn-opt-revision-type revision) (scheme-object receiver) (bool recurse) (c-string user) (c-string pass))
766#<<EOF
767  void *receiverroot;
768
769  apr_hash_t *props;
770  apr_pool_t *pool;
771  svn_opt_revision_t head;
772  apr_hash_index_t *tmp;
773  svn_error_t *err;
774
775  svnwiki_user = user;
776  svnwiki_pass = pass;
777
778  pool = svn_pool_create(NULL);
779
780  receiverroot = CHICKEN_new_gc_root();
781
782  CHICKEN_gc_root_set(receiverroot, receiver);
783
784  err = svn_client_info(path_or_url, peg_revision, revision, svn_client_info_receiver, receiverroot, recurse, svn_ctx, pool);
785  if (err)
786    {
787      apr_pool_destroy(pool);
788      svn_handle_error(err, stderr, FALSE);
789      svn_error_clear(err);
790      return(C_SCHEME_FALSE);
791    }
792
793  apr_pool_destroy(pool);
794
795  CHICKEN_delete_gc_root(receiverroot);
796
797  return(C_SCHEME_TRUE);
798EOF
799))
800
801(define-external (svn_client_info_receiver ((pointer void) baton) (c-string path) (svn-info-type info) (apr-pool-type pool)) svn-error-type
802  ((gc-root-ref baton) path info)
803  svn-no-error)
Note: See TracBrowser for help on using the repository browser.