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

Last change on this file since 15325 was 15325, checked in by sjamaan, 11 years ago

Initial, quick 'n dirty port of svn-client to chicken 4

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