(module svn-client
  (svn-info? svn-info-url svn-info-repos-root-url
   svn-info-rev svn-info-last-changed-rev svn-client-info

   svn-file? svn-file-base-path svn-file-path svn-file-kind
   svn-file-size svn-file-has-props? svn-file-last-changed-revision
   svn-file-last-changed-time svn-file-last-changed-author

   svn-log? svn-log-message svn-log-author svn-log-date
   svn-log-revision svn-log-changes

   svn-log-change? svn-log-change-path svn-log-change-action
   svn-log-change-from-path svn-log-change-from-revision

   make-svn-opt-revision-number svn-opt-revision-head
   svn-opt-revision-unspecified

   svn-commit svn-checkout svn-diff svn-client-list svn-propget
   svn-propset-local svn-add svn-client-log svn-client-revert
   svn-client-cat svn-update

   svn-repos-create
   )

(import chicken scheme foreign)
(use lolevel)

(foreign-declare "#include \"svn-client-base.c\"")

(define gc-root-ref
  (foreign-lambda* scheme-object (((c-pointer "void") root))
    "C_return(CHICKEN_gc_root_ref(root));"))

;;; Pools

(define-record apr-pool ptr)

(define-foreign-type
  apr-pool-type
  (c-pointer "apr_pool_t")
  apr-pool-ptr
  make-apr-pool)

(define svn-pool-create
  (foreign-lambda apr-pool-type "svn_pool_create" apr-pool-type))

;;; Hashes

(define-record apr-hash ptr)

(define-foreign-type
  apr-hash-type
  (c-pointer "apr_hash_t")
  apr-hash-ptr
  make-apr-hash)

;; This is sooo stupid
(define canonicalize-path-or-url
  (foreign-lambda nonnull-c-string*
      "svnclient_canonicalize_path_or_url" nonnull-c-string))

(define-foreign-type svn-path-or-url c-string canonicalize-path-or-url)

;; For svn-strings only
(define (apr-hash-ref hash key)
  ((foreign-safe-lambda* c-string ((apr-hash-type hash)
                                   ((const c-string) key))
    "svn_string_t *res_s;" ;; How nice that this is so well-documented *COUGH*
    "if ((res_s = apr_hash_get(hash, key, APR_HASH_KEY_STRING)))"
    "  C_return(res_s->data);" ;; Can we do this? svn's compat.c sure thinks so!
    "else"
    "  C_return(NULL);") hash key))

;;; Errors

(define-record svn-error ptr)

(define-foreign-type
  svn-error-type
  (c-pointer "svn_error_t")
  svn-error-ptr
  make-svn-error)

(define svn-no-error
  (foreign-value "SVN_NO_ERROR" svn-error-type))

;;; Info

(define-record svn-info url repos-root-url rev last-changed-rev)

(define-foreign-type
  svn-info-type
  (c-pointer "svn_client_info2_t"))

;;; log
(define-foreign-type
  svn-log-entry-type
  (c-pointer "svn_log_entry_t"))

(define svn-log-entry-changed-paths
  (foreign-lambda* apr-hash-type ((svn-log-entry-type log))
    "C_return(log->changed_paths);"))

(define svn-log-entry-revision
  (foreign-lambda* svn-revnum-type ((svn-log-entry-type log))
    "C_return(log->revision);"))

(define svn-log-entry-revprops
  (foreign-lambda* apr-hash-type ((svn-log-entry-type log))
    "C_return(log->revprops);"))

;;; Revisions

(define-record svn-opt-revision ptr)

(define (make-svn-opt-revision-with-finalizer x)
  (set-finalizer! x free)
  (make-svn-opt-revision x))

(define-foreign-type
  svn-opt-revision-type
  (c-pointer "svn_opt_revision_t")
  svn-opt-revision-ptr
  make-svn-opt-revision-with-finalizer)

(define make-svn-opt-revision-number
  (foreign-lambda* svn-opt-revision-type ((long num))
    "svn_opt_revision_t *rev = malloc(sizeof(svn_opt_revision_t));"
    "if (rev) {"
    "  rev->kind = svn_opt_revision_number;"
    "  rev->value.number = num;"
    "}"
    "C_return(rev);"))

(define svn-opt-revision-head
  (make-svn-opt-revision
   (foreign-value "&revision_head" (c-pointer "svn_opt_revision_t"))))

(define svn-opt-revision-unspecified
  (make-svn-opt-revision
   (foreign-value "&revision_unspecified" (c-pointer "svn_opt_revision_t"))))

(define svn-opt-revision-number
  (foreign-lambda* long ((svn-opt-revision-type rev))
    "C_return(rev->kind == svn_opt_revision_number ? rev->value.number : -1);"))

(define svn-opt-revision-kind
  (foreign-lambda* unsigned-int ((svn-opt-revision-type rev))
    "C_return(rev->kind);"))

(define-foreign-type svn-revnum-type long)

;;; svn_log_changed_path_t

(define-record svn-log-changed-path ptr)

(define (make-svn-log-changed-path-with-finalizer x)
  (set-finalizer! x
    (foreign-lambda* void (((c-pointer "svn_log_changed_path_t") obj))
      "if (obj) free(obj);"))
  (make-svn-log-changed-path x))

(define-foreign-type
  svn-log-changed-path-type
  (c-pointer "svn_log_changed_path_t")
  svn-log-changed-path-ptr
  make-svn-log-changed-path-with-finalizer)

(define svn-log-changed-path-action
  (foreign-lambda* char ((svn-log-changed-path-type info))
    "C_return(info->action);"))

(define svn-log-changed-path-copy-from-path
  (foreign-lambda* c-string ((svn-log-changed-path-type info))
    "C_return(info->copyfrom_path);"))

(define svn-log-changed-path-copy-from-rev
  (foreign-lambda* long ((svn-log-changed-path-type info))
    "C_return(info->copyfrom_rev);"))

;;; lock
(define-foreign-type svn-lock-type (c-pointer "svn_lock_t"))

;;; dirent
(define-foreign-type svn-dirent-type (c-pointer "svn_dirent_t"))

(define svn-dirent-kind
  (foreign-lambda* (enum "svn_node_kind_t") ((svn-dirent-type dirent))
    "C_return(dirent->kind);"))

(define svn-dirent-size
  (foreign-lambda* unsigned-integer64 ((svn-dirent-type dirent))
    "C_return(dirent->size);"))

(define svn-dirent-has-props?
  (foreign-lambda* bool ((svn-dirent-type dirent))
    "C_return(dirent->has_props);"))

(define svn-dirent-created-rev
  (foreign-lambda* long ((svn-dirent-type dirent))
    "C_return(dirent->created_rev);"))

(define svn-dirent-time
  (foreign-lambda* unsigned-integer64 ((svn-dirent-type dirent))
    "C_return(dirent->time);"))

(define svn-dirent-last-author
  (foreign-lambda* c-string ((svn-dirent-type dirent))
    "C_return(dirent->last_author);"))

;;; Depth
(define-foreign-type svn-depth
  int
  (lambda (d)
    (cond ((boolean? d)
           (if d
               (foreign-value "svn_depth_infinity" int)
               (foreign-value "svn_depth_empty" int)))
          ((fixnum? d) d)
          (else (error "Not a correct depth value!")))))

;;; Other stuff

(define svn-commit
  (foreign-lambda* scheme-object ((c-string path) (svn-depth depth)
                                  (c-string user) (c-string pass)
                                  (c-string changes))
#<<EOF
  apr_array_header_t *targets = NULL;
  svn_error_t *err;
  C_word retval = C_SCHEME_TRUE;
  apr_pool_t *tmp_pool;
  tmp_pool = svn_pool_create(NULL);

  targets = apr_array_make(tmp_pool, 1, sizeof(char *));

  (*((const char **) apr_array_push (targets))) = path;

  set_creds_for_next_command(user, pass);

  svn_ctx->log_msg_func = svnwiki_log_callback;
  svn_ctx->log_msg_baton = changes;

  err = svn_client_commit6(targets, depth, FALSE, FALSE, FALSE,
                           FALSE, FALSE, NULL, NULL,
                           svnclient_commit_set_revision,
                           &retval, svn_ctx, tmp_pool);
  if (err) {
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    svn_pool_destroy(tmp_pool);
    C_return(C_SCHEME_FALSE);
  }

  svn_pool_destroy(tmp_pool);
  C_return(retval);
EOF
))

(define svn-checkout
  (foreign-lambda* scheme-object ((c-string url) (c-string path)
                                  (svn-opt-revision-type rev) (svn-depth depth)
                                  (c-string user) (c-string pass))
#<<EOF
  svn_revnum_t revnum;
  svn_error_t *err;
  apr_pool_t *tmp_pool;
  tmp_pool = svn_pool_create(NULL);
  
  /* Blergh */
  svn_opt_revision_t peg_revision;
  peg_revision.kind = svn_opt_revision_unspecified;

  set_creds_for_next_command(user, pass);

  err = svn_client_checkout3(&revnum, url, path, &peg_revision,
                             rev, depth, FALSE, FALSE, svn_ctx, tmp_pool);
  svn_pool_destroy(tmp_pool);
  if (err) {
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(C_SCHEME_FALSE);
  }

  C_return(C_fix(revnum));
EOF
))

(define svn-update
  (foreign-lambda* scheme-object ((svn-path-or-url path)
                                  (svn-opt-revision-type rev) (svn-depth depth)
                                  (c-string user) (c-string pass))
#<<EOF
  apr_array_header_t *paths = NULL;
  svn_error_t *err;
  apr_pool_t *tmp_pool;
  tmp_pool = svn_pool_create(NULL);

  set_creds_for_next_command(user, pass);

  paths = apr_array_make(tmp_pool, 1, sizeof(char *));
  *(char **)apr_array_push(paths) = path;
  
  err = svn_client_update4(NULL, paths, rev, depth,
                           FALSE, FALSE, TRUE, FALSE, TRUE,
                           svn_ctx, tmp_pool);
  svn_pool_destroy(tmp_pool);
  if (err) {
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(C_SCHEME_FALSE);
  }

  C_return(C_SCHEME_TRUE);
EOF
))

(define svn-diff
  (foreign-lambda* c-string* ((svn-path-or-url path) (svn-depth depth)
                              (c-string user) (c-string pass))
#<<EOF
  apr_array_header_t *diff_opts = NULL;
  char template[] = "/tmp/svnwiki-diff-XXXXXX";
  svn_opt_revision_t rev1, rev2;
  apr_file_t *outfile;
  svn_stream_t *outstream;
  svn_error_t *err;
  apr_pool_t *tmp_pool;
  tmp_pool = svn_pool_create(NULL);

  diff_opts = apr_array_make(tmp_pool, 0, sizeof (char *));
  
  rev1.kind = svn_opt_revision_head;
  rev2.kind = svn_opt_revision_working;

  apr_file_mktemp(&outfile, template, APR_CREATE|APR_WRITE|APR_EXCL, tmp_pool);
  outstream = svn_stream_from_aprfile2(outfile, FALSE, tmp_pool);
  
  set_creds_for_next_command(user, pass);

  err = svn_client_diff6(diff_opts, path, &rev1, path, &rev2,
                         NULL, depth, FALSE, TRUE, TRUE, FALSE,
                         FALSE, FALSE, FALSE, FALSE, APR_LOCALE_CHARSET,
                         outstream, NULL, NULL, svn_ctx, tmp_pool);
  svn_pool_destroy(tmp_pool);
  svn_stream_close(outstream);
  apr_file_close(outfile);
  if (err) {
    apr_file_remove(template, tmp_pool);
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(NULL);
  }
  C_return(strdup(template));
EOF
))

(define svn-client-list
  (foreign-safe-lambda* scheme-object
      ((svn-path-or-url path) (svn-opt-revision-type rev)
       (svn-depth depth) (c-string user) (c-string pass))
#<<EOF
  void *resultroot;
  svn_error_t *err;
  svn_opt_revision_t head;
  const char *can_path;
  apr_pool_t *tmp_pool;
  C_word result;
  C_word a[C_SIZEOF_PAIR], *ap = a;

  /* Blergh */
  svn_opt_revision_t peg_revision;
  peg_revision.kind = svn_opt_revision_unspecified;

  /* (cons #f '()) => updated by set-cdr! in svn_ls_add. cdr is returned */
  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);

  /* Is this really necessary? */
  resultroot = CHICKEN_new_gc_root();
  CHICKEN_gc_root_set(resultroot, result);
  
  tmp_pool = svn_pool_create(NULL);

  head.kind = svn_opt_revision_head;

  set_creds_for_next_command(user, pass);

  /* Use DIRENT_ALL? */
  err = svn_client_list3(path, &peg_revision, rev, depth, SVN_DIRENT_ALL,
                         TRUE, FALSE, svn_ls_add, resultroot,
                         svn_ctx, tmp_pool);
  if (err) {
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    svn_pool_destroy(tmp_pool);
    CHICKEN_delete_gc_root(resultroot);
    C_return(C_SCHEME_FALSE);
  }

  svn_pool_destroy(tmp_pool);

  result = CHICKEN_gc_root_ref(resultroot);
  CHICKEN_delete_gc_root(resultroot);
  
  C_return(revlist(C_u_i_cdr(result)));
EOF
))

(define-external (revlist (scheme-object list)) scheme-object (reverse list))

;; We could just pass the dirent around, but doing this copies stuff
;; to Scheme memory so we can just deallocate the pool when done.
(define-record svn-file
  base-path path kind size has-props?
  last-changed-revision last-changed-time last-changed-author)

(define-external
  (svn_ls_add ((c-pointer void) baton) ((const c-string) path)
              ((const svn-dirent-type) dirent) ((const svn-lock-type) lock)
              ((const c-string) base-path)
              ((const c-string) external-parent-url)
              ((const c-string) external-target)
              (apr-pool-type pool))
  svn-error-type
  (let* ((result (gc-root-ref baton))
         ;; "unused" is to trick the compiler into thinking lock and pool are
         ;; used, as a workaround for bug #584
         (unused (list lock pool))
         (kind (svn-dirent-kind dirent))
         (kind-symbol (cond
                       ((= kind (foreign-value "svn_node_none" int)) 'none)
                       ((= kind (foreign-value "svn_node_file" int)) 'file)
                       ((= kind (foreign-value "svn_node_dir"  int)) 'directory)
                       (else 'unknown)))
         (svn-file (make-svn-file base-path path
                                  kind-symbol (svn-dirent-size dirent)
                                  (svn-dirent-has-props? dirent)
                                  (svn-dirent-created-rev dirent)
                                  (svn-dirent-time dirent)
                                  (svn-dirent-last-author dirent))))
    (set-cdr! result (cons svn-file (cdr result)))
    svn-no-error))

; Currently returns a list of all property values for a given file.
(define svn-propget
  (foreign-safe-lambda* scheme-object ((c-string propname) (c-string target)
                                       (svn-opt-revision-type rev)
                                       (svn-depth depth)
                                       (c-string user) (c-string pass))
#<<EOF
  apr_hash_t *props;
  apr_pool_t *pool;
  apr_hash_index_t *tmp;
  svn_error_t *err;
  void *resultroot;
  C_word result;
  C_word a[C_SIZEOF_PAIR], *ap = a;

  /* Blergh */
  svn_opt_revision_t peg_revision;
  peg_revision.kind = svn_opt_revision_unspecified;
  
  pool = svn_pool_create(NULL);
  
  /* (cons #f '()) => updated by set-cdr! in svn_propget_add. cdr is returned */
  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);

  resultroot = CHICKEN_new_gc_root();

  CHICKEN_gc_root_set(resultroot, result);

  set_creds_for_next_command(user, pass);

  err = svn_client_propget5(&props, NULL, propname, target,
                            &peg_revision, rev, NULL, depth,
                            NULL, svn_ctx, pool, pool);
  if (err) {
    apr_pool_destroy(pool);
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(C_SCHEME_FALSE);
  }

  for (tmp = apr_hash_first(pool, props); tmp; tmp = apr_hash_next(tmp)) {
    const void *key;
    apr_ssize_t keylen;
    svn_string_t *value;

    apr_hash_this(tmp, &key, &keylen, (void **) &value);
    svn_propget_add(key, value->data, resultroot);
  }

  apr_pool_destroy(pool);

  result = CHICKEN_gc_root_ref(resultroot);
  CHICKEN_delete_gc_root(resultroot);

  C_return(revlist(C_u_i_cdr(result)));
EOF
))

(define-external (svn_propget_add ((const c-string) key)
                                  ((const c-string) value)
                                  ((c-pointer void) baton))
  void
  (let ((result (gc-root-ref baton)))
    (set-cdr! result (cons (list key value) (cdr result)))))

(define svn-propset-local
  (foreign-safe-lambda* scheme-object ((c-string propname)
                                       (c-string propval)
                                       ;; Really just a path
                                       (svn-path-or-url path)
                                       (svn-depth depth)
                                       (bool skip_checks))
#<<EOF
  svn_error_t *err;
  apr_pool_t *tmp_pool;
  apr_array_header_t *targets;
  tmp_pool = svn_pool_create(NULL);

  targets = apr_array_make(tmp_pool, 1, sizeof(char *));
  *(char **)apr_array_push(targets) = path;

  err = svn_client_propset_local(
          propname, svn_string_create(propval, tmp_pool), /* WHY??? */
          targets, depth, skip_checks, NULL, svn_ctx, tmp_pool);
  apr_pool_destroy(tmp_pool);
  if (err) {
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(C_SCHEME_FALSE);
  }
  C_return(C_SCHEME_TRUE);
EOF
))

(define svn-add
  (foreign-safe-lambda* scheme-object (;; Really just a path
                                       (svn-path-or-url path)
                                       (svn-depth depth)
                                       (c-string user) (c-string pass))
#<<EOF
  svn_error_t *err;
  apr_pool_t *tmp_pool;
  tmp_pool = svn_pool_create(NULL);

  set_creds_for_next_command(user, pass);

  err = svn_client_add5(path, depth, FALSE, FALSE, FALSE,
                        FALSE, svn_ctx, tmp_pool);
  svn_pool_destroy(tmp_pool);
  if (err) {
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(C_SCHEME_FALSE);
  }
  C_return(C_SCHEME_TRUE);
EOF
))

;;; History

(define-record svn-log-change path action from-path from-revision)

(define-external (changed_paths_fix_one ((const c-string) path)
                                        (svn-log-changed-path-type log-cp)
                                        ((c-pointer void) root))
  void
  (let* ((result (gc-root-ref root))
         (action (case (svn-log-changed-path-action log-cp)
                   ((#\A) 'added)
                   ((#\D) 'deleted)
                   ((#\R) 'replaced)
                   ((#\M) 'modified)
                   (else  'unknown)))
         (from-path (svn-log-changed-path-copy-from-path log-cp))
         (from-rev (svn-log-changed-path-copy-from-rev log-cp))
         (log-change (make-svn-log-change path action from-path from-rev)))
    (set-cdr! result (cons log-change (cdr result)))))

(define changed-paths-fix
  (foreign-safe-lambda* scheme-object ((apr-hash-type paths))
#<<EOF
  apr_pool_t *tmp_pool;
  void *resultroot;
  apr_hash_index_t *tmp;
  C_word result;
  C_word a[C_SIZEOF_PAIR], *ap = a;

  if (!paths)
    C_return(C_SCHEME_END_OF_LIST);

  resultroot = CHICKEN_new_gc_root();
  /* (cons #f '()) => updated by set-cdr! in changed_paths_fix_one. cdr is returned */
  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);

  CHICKEN_gc_root_set(resultroot, result);

  tmp_pool = svn_pool_create(NULL);

  for (tmp = apr_hash_first(tmp_pool, paths); tmp; tmp = apr_hash_next(tmp)) {
    const void *key;
    void *old;
    apr_ssize_t keylen;
    svn_log_changed_path_t *new = malloc(sizeof(svn_log_changed_path_t));

    /* WTF */
    apr_hash_this(tmp, &key, &keylen, &old);

    *new = * (svn_log_changed_path_t *) old;

    changed_paths_fix_one(key, new, resultroot);
  }
  svn_pool_destroy(tmp_pool);
  result = CHICKEN_gc_root_ref(resultroot);
  CHICKEN_delete_gc_root(resultroot);

  C_return(revlist(C_u_i_cdr(result)));
EOF
))

(define svn-client-log
  (foreign-safe-lambda* scheme-object ((svn-path-or-url 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))
#<<EOF
  apr_array_header_t *targets;
  apr_pool_t *tmp_pool;
  svn_error_t *err;
  void *resultroot = CHICKEN_new_gc_root();
  apr_array_header_t *revprops, *revranges;
  svn_opt_revision_range_t range;
  svn_boolean_t include_merged_revs = FALSE;
  C_word result;
  C_word a[C_SIZEOF_PAIR], *ap = a;
  
  /* Blergh */
  svn_opt_revision_t peg_revision;
  peg_revision.kind = svn_opt_revision_unspecified;

  /* (cons #f '()) => updated by set-cdr! in svn_history_add. cdr is returned */
  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);
  
  CHICKEN_gc_root_set(resultroot, result);

  tmp_pool = svn_pool_create(NULL);

  targets = apr_array_make(tmp_pool, 1, sizeof(char *));
  *(char **)apr_array_push(targets) = path;

  /* These should probably be passed as an argument too */
  revprops = apr_array_make(tmp_pool, 3, sizeof(char *));
  APR_ARRAY_PUSH(revprops, char *) = "svn:author";
  APR_ARRAY_PUSH(revprops, char *) = "svn:date";
  APR_ARRAY_PUSH(revprops, char *) = "svn:log";

  set_creds_for_next_command(user, pass);

  range.start = *start;
  range.end = *end;

  revranges = apr_array_make(tmp_pool, 1, sizeof(svn_opt_revision_range_t *));
  APR_ARRAY_PUSH(revranges, svn_opt_revision_range_t *) = &range;

  err = svn_client_log5(targets, &peg_revision, revranges, limit,
                                 discover_changed_paths, strict_node_history,
                                 include_merged_revs, revprops, svn_history_add,
                                 (void *) resultroot, svn_ctx, tmp_pool);

  svn_pool_destroy(tmp_pool);
  if (err) {
    CHICKEN_delete_gc_root(resultroot);
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(C_SCHEME_FALSE);
  }

  result = CHICKEN_gc_root_ref(resultroot);
  CHICKEN_delete_gc_root(resultroot);
  
  C_return(C_u_i_cdr(result));
EOF
))

;; We could just pass the log entry around, but doing this copies stuff
;; to Scheme memory so we can just deallocate the pool when done.
(define-record svn-log message author date changes revision)

(define-external (svn_history_add ((c-pointer void) baton)
                                  (svn-log-entry-type entry)
                                  (apr-pool-type pool))
  svn-error-type
  (let* ((result (gc-root-ref baton))
         (paths (changed-paths-fix (svn-log-entry-changed-paths entry)))
         (h (svn-log-entry-revprops entry))
         (svn-log (make-svn-log (apr-hash-ref h "svn:log")
                                (apr-hash-ref h "svn:author")
                                (apr-hash-ref h "svn:date")
                                paths
                                (svn-log-entry-revision entry))))
    (set-cdr! result (cons svn-log (cdr result)))
    svn-no-error))

(define get-lock
  (foreign-lambda* scheme-object ((c-string path))
#<<EOF
  int fd;
  mkdir(path, S_IRWXU);
  if ((fd = open(path, O_RDONLY)) == -1 || flock(fd, LOCK_EX) == -1) {
    fprintf(stderr, "%s: %s\n", path, strerror(errno));
    exit(EXIT_FAILURE);
  }
  return C_SCHEME_TRUE;
EOF
))

(define svn-time-from-cstring
  (foreign-lambda* number ((c-string data))
#<<EOF
  apr_time_t when;
  apr_pool_t *tmp_pool;
  tmp_pool = svn_pool_create(NULL);
  svn_time_from_cstring(&when, data, tmp_pool);
  apr_pool_destroy(tmp_pool);
  C_return((double) when);
EOF
))

(define svn-client-revert
  (foreign-safe-lambda* bool ((scheme-object paths) (svn-depth depth)
                              (c-string user) (c-string pass))
#<<EOF
  apr_pool_t *tmp_pool;
  apr_array_header_t *paths_array;
  svn_error_t *err;
  C_word tmp;
  int len = 0;

  tmp_pool = svn_pool_create(NULL);

  for (tmp = paths; C_i_pairp(tmp) && tmp != C_SCHEME_END_OF_LIST; tmp = C_u_i_cdr(tmp))
    len ++;

  paths_array = apr_array_make(tmp_pool, len, sizeof(char *));

  for (tmp = paths; C_i_pairp(tmp) && tmp != C_SCHEME_END_OF_LIST; tmp = C_u_i_cdr(tmp)) {
    int len = C_header_size(C_u_i_car(tmp));
    char *buffer = apr_palloc(tmp_pool, len + 1);

    strncpy(buffer, C_c_string(C_u_i_car(tmp)), len);
    buffer[len] = 0;

    (*((const char **) apr_array_push(paths_array))) = buffer;
  }

  set_creds_for_next_command(user, pass);

  err = svn_client_revert2(paths_array, depth, NULL, svn_ctx, tmp_pool);

  apr_pool_destroy(tmp_pool);

  if (err) {
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(C_SCHEME_FALSE);
  }

  C_return(C_SCHEME_TRUE);
EOF
))

(define svn-client-cat
  (foreign-safe-lambda* c-string* ((svn-path-or-url path_or_url)
                                   (svn-opt-revision-type revision)
                                   (c-string user) (c-string pass))
#<<EOF
  apr_array_header_t *diff_opts = NULL;
  char template[] = "/tmp/svnwiki-cat-XXXXXX";
  apr_file_t *outfile;
  svn_stream_t *out;
  apr_pool_t *tmp_pool;
  svn_opt_revision_t head;

  apr_file_t *stdout_file;
  svn_error_t *err;

  tmp_pool = svn_pool_create(NULL);

  diff_opts = apr_array_make(tmp_pool, 0, sizeof (char *));

  apr_file_mktemp(&outfile, template, APR_CREATE | APR_WRITE | APR_EXCL, tmp_pool);
  out = svn_stream_from_aprfile2(outfile, FALSE, tmp_pool);

  set_creds_for_next_command(user, pass);

  head.kind = svn_opt_revision_unspecified;
  err = svn_client_cat2(out, path_or_url, &head, revision, svn_ctx, tmp_pool);
  if (err) {
    svn_stream_close(out);
    apr_file_remove(template, tmp_pool);
    apr_pool_destroy(tmp_pool);
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(NULL);
  }

  svn_stream_close(out);
  apr_pool_destroy(tmp_pool);

  C_return(strdup(template));
EOF
))

(define svn-client-info
  (foreign-safe-lambda* void ((svn-path-or-url abspath_or_url)
                              (svn-opt-revision-type peg_revision)
                              (svn-opt-revision-type revision) (svn-depth depth)
                              (c-string user) (c-string pass))
#<<EOF
  void *resultroot;

  apr_hash_t *props;
  apr_pool_t *tmp_pool;
  svn_opt_revision_t head;
  apr_hash_index_t *tmp;
  svn_error_t *err;
  C_word result;
  C_word a[C_SIZEOF_PAIR], *ap = a;

  tmp_pool = svn_pool_create(NULL);

  /* (cons #f '()) => updated by set-cdr! in svn_client_info_receiver. cdr is returned */
  result = C_a_pair(&ap, C_SCHEME_FALSE, C_SCHEME_END_OF_LIST);
  
  resultroot = CHICKEN_new_gc_root();
  CHICKEN_gc_root_set(resultroot, result);

  set_creds_for_next_command(user, pass);

  err = svn_client_info3(abspath_or_url, peg_revision, revision,
                         depth, TRUE, TRUE, NULL,
                         svn_client_info_receiver, resultroot,
                         svn_ctx, tmp_pool);
  if (err) {
    apr_pool_destroy(tmp_pool);
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    CHICKEN_delete_gc_root(resultroot);
    C_return(C_SCHEME_FALSE);
  }

  apr_pool_destroy(tmp_pool);

  result = CHICKEN_gc_root_ref(resultroot);
  CHICKEN_delete_gc_root(resultroot);

  C_return(revlist(C_u_i_cdr(result)));
EOF
))

(define-external (svn_client_info_receiver ((c-pointer void) baton)
                                           ((const c-string) path-or-url)
                                           ((const svn-info-type) info)
                                           (apr-pool-type scratch-pool))
  svn-error-type
  (let ((result (gc-root-ref baton)))
    (set-cdr! result
              (cons (list path-or-url
                          (make-svn-info
                           ((foreign-lambda* c-string ((svn-info-type info))
                                             "C_return(info->URL);") info)
                           ((foreign-lambda* c-string ((svn-info-type info))
                                             "C_return(info->repos_root_URL);") info)
                           ((foreign-lambda* long ((svn-info-type info))
                                             "C_return(info->rev);") info)
                           ((foreign-lambda* long ((svn-info-type info))
                                             "C_return(info->last_changed_rev);") info)))
                    (cdr result)))
    svn-no-error))


(define svn-repos-create
  (foreign-lambda* scheme-object ((nonnull-c-string path)) #<<EOF
  apr_pool_t *tmp_pool;
  svn_error_t *err;
  svn_repos_t *repos_p;

  tmp_pool = svn_pool_create(NULL);
  err = svn_repos_create (&repos_p, path, NULL, NULL, NULL, NULL, tmp_pool);
  svn_pool_destroy(tmp_pool);
  if (err) {
    svn_handle_error2(err, stderr, FALSE, "svn: ");
    svn_error_clear(err);
    C_return(C_SCHEME_FALSE);
  }
  C_return(C_SCHEME_TRUE);
EOF
))

;;; Init

((foreign-lambda void "chicken_svn_client_lib_initialize"))

)