source: project/svn-client/tags/0.6/svn-client.scm @ 2501

Last change on this file since 2501 was 2501, checked in by azul, 14 years ago

Last minute fixes.

File size: 17.8 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      return(C_SCHEME_FALSE);
299    }
300  if (!commit_info || commit_info->revision == SVN_INVALID_REVNUM)
301    return(C_SCHEME_TRUE);
302  return(C_fix(commit_info->revision));
303EOF
304))
305
306(define svn-update
307  (foreign-lambda* scheme-object ((c-string url) (c-string path) (svn-opt-revision-type rev) (c-string user) (c-string pass))
308#<<EOF
309  svn_revnum_t revnum;
310  svn_error_t *err;
311
312  svnwiki_user = user;
313  svnwiki_pass = pass;
314
315  err = svn_client_checkout(&revnum, url, path, rev, TRUE, svn_ctx, svn_pool);
316  if (err)
317    {
318      svn_handle_error(err, stderr, FALSE);
319      svn_error_clear(err);
320      return(C_SCHEME_FALSE);
321    }
322
323  return(C_fix(revnum));
324EOF
325))
326
327(define svn-diff
328  (foreign-lambda* c-string* ((c-string path) (c-string user) (c-string pass))
329#<<EOF
330  apr_array_header_t *diff_opts = apr_array_make(svn_pool, 0, sizeof (char *));
331  char template[] = "/tmp/svnwiki-diff-XXXXXX";
332  svn_opt_revision_t rev1, rev2;
333  apr_file_t *outfile;
334
335  svnwiki_user = user;
336  svnwiki_pass = pass;
337
338  rev1.kind = svn_opt_revision_head;
339  rev2.kind = svn_opt_revision_working;
340
341  mkstemp(template);
342  apr_file_open(&outfile, template, APR_WRITE, APR_OS_DEFAULT, svn_pool);
343  svn_client_diff(diff_opts, path, &rev1, path, &rev2, TRUE, FALSE, TRUE, outfile, NULL, svn_ctx, svn_pool);
344  apr_file_close(outfile);
345  return(strdup(template));
346EOF
347))
348
349(define svn-ls
350  (foreign-safe-lambda* scheme-object ((c-string path) (scheme-object result) (c-string user) (c-string pass))
351#<<EOF
352  apr_hash_t *dirents;
353  apr_hash_index_t *tmp;
354  svn_opt_revision_t head;
355  const char *can_path = svn_path_internal_style(path, svn_pool);
356
357  head.kind = svn_opt_revision_head;
358
359  svnwiki_user = user;
360  svnwiki_pass = pass;
361
362  svn_client_ls(&dirents, can_path, &head, FALSE, svn_ctx, svn_pool);
363  for (tmp = apr_hash_first(svn_pool, dirents); tmp; tmp = apr_hash_next(tmp))
364    {
365      const void *key;
366      apr_ssize_t keylen;
367      svn_dirent_t *value;
368
369      apr_hash_this(tmp, &key, &keylen, (void **) &value);
370      result = svn_ls_add(key,
371                          value->kind == svn_node_file ? C_fix(value->size) : C_SCHEME_FALSE,
372                          value->created_rev,
373                          result);
374    }
375  return(result);
376EOF
377))
378
379(define-external (svn_ls_add (c-string key) (scheme-object size) (long rev) (scheme-object result)) scheme-object
380  (cons (list key size rev) result))
381
382; Currently returns a list of all property values for a given file.
383
384(define svn-propget
385  (foreign-safe-lambda* scheme-object ((c-string propname) (c-string target) (c-string user) (c-string pass) (scheme-object result))
386#<<EOF
387  apr_hash_t *props;
388  apr_pool_t *pool;
389  svn_opt_revision_t head;
390  apr_hash_index_t *tmp;
391  svn_error_t *err;
392  void *resultroot;
393
394  head.kind = svn_opt_revision_unspecified;
395
396  svnwiki_user = user;
397  svnwiki_pass = pass;
398
399  pool = svn_pool_create(NULL);
400
401  resultroot = CHICKEN_new_gc_root();
402
403  CHICKEN_gc_root_set(resultroot, result);
404
405  err = svn_client_propget(&props, propname, target, &head, FALSE, svn_ctx, pool);
406  if (err)
407    {
408      svn_handle_error(err, stderr, FALSE);
409      return(C_SCHEME_FALSE);
410    }
411
412  for (tmp = apr_hash_first(pool, props); tmp; tmp = apr_hash_next(tmp))
413    {
414      const void *key;
415      apr_ssize_t keylen;
416      svn_string_t *value;
417
418      apr_hash_this(tmp, &key, &keylen, (void **) &value);
419      CHICKEN_gc_root_set(resultroot, svn_propget_add(key, value->data, resultroot));
420    }
421
422  apr_pool_destroy(pool);
423
424  result = CHICKEN_gc_root_ref(resultroot);
425  CHICKEN_delete_gc_root(resultroot);
426
427  return(result);
428EOF
429))
430
431(define-external (svn_propget_add (c-string key) (c-string value) ((pointer void) result)) scheme-object
432  (cons (list key value) (gc-root-ref result)))
433
434(define svn-add
435  (foreign-safe-lambda* scheme-object ((c-string path))
436#<<EOF
437  return(svn_client_add(path, 0, svn_ctx, svn_pool) ? C_SCHEME_FALSE : C_SCHEME_TRUE);
438EOF
439))
440
441;;; History
442
443(define gc-root-ref
444  (foreign-lambda* void (((pointer "void") root)) "return(CHICKEN_gc_root_ref(root));"))
445
446(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
447  (let ((paths (changed-paths-fix changed-paths '())))
448    ((gc-root-ref root) paths rev author date message))
449  svn-no-error)
450
451(define-external (changed_paths_fix_one (c-string key) (svn-log-changed-path-type log-cp) ((pointer void) root)) scheme-object
452  (cons (cons key log-cp) (gc-root-ref root)))
453
454(define changed-paths-fix
455  (foreign-safe-lambda* scheme-object ((apr-hash-type paths) (scheme-object result)) #<<EOF
456  apr_pool_t *pool;
457  void *resultroot;
458  apr_hash_index_t *tmp;
459
460  if (!paths)
461    return(result);
462
463  resultroot = CHICKEN_new_gc_root();
464
465  CHICKEN_gc_root_set(resultroot, result);
466
467  pool = svn_pool_create(NULL);
468
469  for (tmp = apr_hash_first(pool, paths); tmp; tmp = apr_hash_next(tmp))
470    {
471      const void *key;
472      void *old;
473      apr_ssize_t keylen;
474      svn_log_changed_path_t *new = malloc(sizeof(svn_log_changed_path_t));
475
476      apr_hash_this(tmp, &key, &keylen, &old);
477
478      *new = * (svn_log_changed_path_t *) old;
479
480      if (new->copyfrom_path)
481        new->copyfrom_path = strdup(new->copyfrom_path);
482
483      CHICKEN_gc_root_set(resultroot, changed_paths_fix_one(key, new, resultroot));
484    }
485  apr_pool_destroy(pool);
486  result = CHICKEN_gc_root_ref(resultroot);
487  CHICKEN_delete_gc_root(resultroot);
488
489  return(result);
490EOF
491))
492
493; Currently returns a list with an entry for each commit between start and end.
494; Each entry is itself a list with the commit message, the number of the
495; revision that was created as the result of the commit, the author, the date
496; of the commit (a string) and the list of changed files.
497
498(define svn-client-log
499  (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))
500#<<EOF
501  apr_array_header_t *targets;
502  apr_pool_t *pool;
503  svn_error_t *err;
504  void *funcroot = CHICKEN_new_gc_root();
505
506  CHICKEN_gc_root_set(funcroot, func);
507
508  pool = svn_pool_create(NULL);
509
510  targets = apr_array_make(pool, 1, sizeof(char *));
511
512  *(char **)apr_array_push(targets) = path;
513
514  svnwiki_user = user;
515  svnwiki_pass = pass;
516
517  err = svn_client_log(targets, start, end, discover_changed_paths, strict_node_history, svn_history_add, (void *) funcroot, svn_ctx, pool);
518
519  apr_pool_destroy(pool);
520  CHICKEN_delete_gc_root(funcroot);
521
522  if (err)
523    {
524      svn_handle_error(err, stderr, FALSE);
525      return(C_SCHEME_FALSE);
526    }
527
528  return(C_SCHEME_TRUE);
529EOF
530))
531
532(define get-lock
533  (foreign-lambda* scheme-object ((c-string path))
534#<<EOF
535  int fd;
536  mkdir(path, S_IRWXU);
537  if ((fd = open(path, O_RDONLY)) == -1 || flock(fd, LOCK_EX) == -1)
538    {
539      fprintf(stderr, "%s: %s\n", path, strerror(errno));
540      exit(EXIT_FAILURE);
541    }
542  return C_SCHEME_TRUE;
543EOF
544))
545
546(define svn-time-from-cstring
547  (foreign-lambda* number ((c-string data))
548#<<EOF
549  apr_time_t when;
550  svn_time_from_cstring(&when, data, svn_pool);
551  return((double) when);
552EOF
553))
554
555(define svn-client-revert
556  (foreign-safe-lambda* bool ((scheme-object paths) (bool recursive) (c-string user) (c-string pass))
557#<<EOF
558  apr_pool_t *pool;
559  apr_array_header_t *paths_array;
560  svn_error_t *err;
561  C_word tmp;
562  int len = 0;
563
564  pool = svn_pool_create(NULL);
565
566  for (tmp = paths; C_i_pairp(tmp) && tmp != C_SCHEME_END_OF_LIST; tmp = C_u_i_cdr(tmp))
567    len ++;
568
569  paths_array = apr_array_make(pool, len, sizeof(char *));
570
571  for (tmp = paths; C_i_pairp(tmp) && tmp != C_SCHEME_END_OF_LIST; tmp = C_u_i_cdr(tmp))
572    {
573      int len = C_header_size(C_u_i_car(tmp));
574      char *buffer = apr_palloc(svn_pool, len + 1);
575
576      strncpy(buffer, C_c_string(C_u_i_car(tmp)), len);
577      buffer[len] = 0;
578
579      (*((const char **) apr_array_push(paths_array))) = buffer;
580    }
581
582  err = svn_client_revert(paths_array, recursive, svn_ctx, pool);
583
584  apr_pool_destroy(pool);
585
586  if (err)
587    {
588      svn_handle_error(err, stderr, FALSE);
589      return(C_SCHEME_FALSE);
590    }
591
592  return(C_SCHEME_TRUE);
593EOF
594))
595
596(define svn-client-resolved
597  (foreign-safe-lambda* bool ((c-string path) (bool recursive))
598#<<EOF
599  apr_pool_t *pool;
600  svn_error_t *err;
601
602  pool = svn_pool_create(NULL);
603
604  err = svn_client_resolved(path, recursive, svn_ctx, pool);
605
606  apr_pool_destroy(pool);
607
608  if (err)
609    {
610      svn_handle_error(err, stderr, FALSE);
611      return(C_SCHEME_FALSE);
612    }
613
614  return(C_SCHEME_TRUE);
615 
616EOF
617))
618
619(define svn-path-canonicalize
620  (foreign-safe-lambda* c-string ((c-string old))
621#<<EOF
622  apr_pool_t *pool;
623  char *new;
624
625  pool = svn_pool_create(NULL);
626
627  new = strdup(svn_path_canonicalize(old, pool));
628
629  apr_pool_destroy(pool);
630
631  return(new);
632EOF
633))
634
635(define svn-client-cat
636  (foreign-safe-lambda* c-string* ((c-string path_or_url) (svn-opt-revision-type revision) (c-string user) (c-string pass))
637#<<EOF
638  apr_array_header_t *diff_opts = apr_array_make(svn_pool, 0, sizeof (char *));
639  char template[] = "/tmp/svnwiki-cat-XXXXXX";
640  apr_file_t *outfile;
641  svn_stream_t *out;
642  apr_pool_t *pool;
643
644  apr_file_t *stdout_file;
645  svn_error_t *err;
646
647  svnwiki_user = user;
648  svnwiki_pass = pass;
649
650  pool = svn_pool_create(NULL);
651
652  mkstemp(template);
653
654  apr_file_open(&outfile, template, APR_WRITE, APR_OS_DEFAULT, pool);
655  out = svn_stream_from_aprfile(outfile, pool);
656
657  err = svn_client_cat(out, path_or_url, revision, svn_ctx, pool);
658  if (err)
659    {
660      svn_handle_error(err, stderr, FALSE);
661      return(NULL);
662    }
663
664  svn_stream_close(out);
665  apr_pool_destroy(pool);
666
667  return(strdup(template));
668EOF
669))
670
671(define svn-client-info
672  (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))
673#<<EOF
674  void *receiverroot;
675
676  apr_hash_t *props;
677  apr_pool_t *pool;
678  svn_opt_revision_t head;
679  apr_hash_index_t *tmp;
680  svn_error_t *err;
681
682  svnwiki_user = user;
683  svnwiki_pass = pass;
684
685  pool = svn_pool_create(NULL);
686
687  receiverroot = CHICKEN_new_gc_root();
688
689  CHICKEN_gc_root_set(receiverroot, receiver);
690
691  err = svn_client_info(path_or_url, peg_revision, revision, svn_client_info_receiver, receiverroot, recurse, svn_ctx, pool);
692  if (err)
693    {
694      svn_handle_error(err, stderr, FALSE);
695      return(C_SCHEME_FALSE);
696    }
697
698  apr_pool_destroy(pool);
699
700  CHICKEN_delete_gc_root(receiverroot);
701
702  return(C_SCHEME_TRUE);
703EOF
704))
705
706(define-external (svn_client_info_receiver ((pointer void) baton) (c-string path) (svn-info-type info) (apr-pool-type pool)) svn-error-type
707  ((gc-root-ref baton) path info)
708  svn-no-error)
Note: See TracBrowser for help on using the repository browser.