[PATCH] Implement prompt callback support for perl bindings

* subversion/bindings/swig/swigutil_pl.c
* subversion/bindings/swig/swigutil_pl.h
* subversion/bindings/swig/svn_client.i
* subversion/bindings/swig/perl/Core.pm
    Implement support in the perl bindings for the prompt functions
    (svn_client_get_simple_prompt_provider,
     svn_client_get_username_prompt_provider,
     svn_client_get_ssl_server_trust_prompt_provider,
     svn_client_get_ssl_client_cert_prompt_provider,
     svn_client_get_ssl_client_cert_pw_prompt_provider)

Index: subversion/bindings/swig/swigutil_pl.c
===================================================================
--- subversion/bindings/swig/swigutil_pl.c (revision 7861)
+++ subversion/bindings/swig/swigutil_pl.c (working copy)
@@ -817,6 +817,207 @@
     return SVN_NO_ERROR;
 }
 
+svn_error_t *svn_swig_pl_thunk_simple_prompt(svn_auth_cred_simple_t **cred,
+ void *baton,
+ const char *realm,
+ const char *username,
+ apr_pool_t *pool)
+{
+ SV *prompt_func, *result;
+ swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *");
+ swig_type_info *credinfo = SWIG_TypeQuery("svn_auth_cred_simple_t *");
+
+ /* baton here contains the pointer to the CV
+ * Before we can use it we need to convert it back to an SV and
+ * place it back in a refernce. We have to do this because the
+ * reference we would be passed at runtime could be reaped by garbage
+ * collection before we make the callback */
+ prompt_func = newRV_inc(INT2PTR(SV *,baton));
+ if (!SvROK(prompt_func) && SvTYPE(SvRV(prompt_func)) != SVt_PVCV)
+ return SVN_NO_ERROR;
+
+ /* Be nice and allocate the memory for the cred structure before passing it
+ * off to the perl space */
+ *cred = apr_pcalloc(pool, sizeof(**cred));
+ if (!*cred) {
+ croak("Could not allocate memory for cred structure");
+ }
+
+ perl_callback_thunk (CALL_SV,
+ prompt_func, &result,
+ "SssS", *cred, credinfo,
+ realm, username, pool, poolinfo);
+
+ /* Must clean up our reference we make or we'll leak */
+ SvREFCNT_dec(prompt_func);
+
+ return SVN_NO_ERROR;
+}
+
+svn_error_t *svn_swig_pl_thunk_username_prompt(svn_auth_cred_username_t **cred,
+ void *baton,
+ const char *realm,
+ apr_pool_t *pool)
+{
+ SV *prompt_func, *result;
+ swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *");
+ swig_type_info *credinfo = SWIG_TypeQuery("svn_auth_cred_username_t *");
+
+ /* baton here contains the pointer to the CV
+ * Before we can use it we need to convert it back to an SV and
+ * place it back in a refernce. We have to do this because the
+ * reference we would be passed at runtime could be reaped by garbage
+ * collection before we make the callback */
+ prompt_func = newRV_inc(INT2PTR(SV *,baton));
+ if (!SvROK(prompt_func) && SvTYPE(SvRV(prompt_func)) != SVt_PVCV)
+ return SVN_NO_ERROR;
+
+ /* Be nice and allocate the memory for the cred structure before passing it
+ * off to the perl space */
+ *cred = apr_pcalloc(pool, sizeof(**cred));
+ if (!*cred) {
+ croak("Could not allocate memory for cred structure");
+ }
+
+ perl_callback_thunk (CALL_SV,
+ prompt_func, &result,
+ "SsS", *cred, credinfo,
+ realm, pool, poolinfo);
+
+ /* Must clean up our reference we make or we'll leak */
+ SvREFCNT_dec(prompt_func);
+
+ return SVN_NO_ERROR;
+}
+
+svn_error_t *svn_swig_pl_thunk_ssl_server_trust_prompt(
+ svn_auth_cred_ssl_server_trust_t **cred,
+ void *baton,
+ const char *realm,
+ int failures,
+ const svn_auth_ssl_server_cert_info_t *cert_info,
+ apr_pool_t *pool)
+{
+ SV *prompt_func, *result;
+ swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *");
+ swig_type_info *credinfo = SWIG_TypeQuery(
+ "svn_auth_cred_ssl_server_trust_t *");
+ swig_type_info *cert_info_info = SWIG_TypeQuery(
+ "svn_auth_ssl_server_cert_info_t *");
+
+ /* baton here contains the pointer to the CV
+ * Before we can use it we need to convert it back to an SV and
+ * place it back in a refernce. We have to do this because the
+ * reference we would be passed at runtime could be reaped by garbage
+ * collection before we make the callback */
+ prompt_func = newRV_inc(INT2PTR(SV *,baton));
+ if (!SvROK(prompt_func) && SvTYPE(SvRV(prompt_func)) != SVt_PVCV)
+ return SVN_NO_ERROR;
+
+ /* Be nice and allocate the memory for the cred structure before passing it
+ * off to the perl space */
+ *cred = apr_pcalloc(pool, sizeof(**cred));
+ if (!*cred) {
+ croak("Could not allocate memory for cred structure");
+ }
+
+ perl_callback_thunk (CALL_SV,
+ prompt_func, &result,
+ "SsiSS", *cred, credinfo,
+ realm, failures,
+ cert_info, cert_info_info,
+ pool, poolinfo);
+
+ /* Must clean up our reference we make or we'll leak */
+ SvREFCNT_dec(prompt_func);
+
+ /* Allow the perl callback to indicate failure by setting all vars to 0
+ * or by simply doing nothing. While still allowing them to indicate
+ * failure by setting the cred strucutre's pointer to 0 via $$cred = 0 */
+ if (*cred) {
+ if ((*cred)->trust_permanently == 0 &&
+ (*cred)->accepted_failures == 0) {
+ *cred = NULL;
+ }
+ }
+
+ return SVN_NO_ERROR;
+}
+
+svn_error_t *svn_swig_pl_thunk_ssl_client_cert_prompt(
+ svn_auth_cred_ssl_client_cert_t **cred,
+ void *baton,
+ apr_pool_t *pool)
+{
+ SV *prompt_func, *result;
+ swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *");
+ swig_type_info *credinfo = SWIG_TypeQuery(
+ "svn_auth_cred_ssl_client_cert_t *");
+
+ /* baton here contains the pointer to the CV
+ * Before we can use it we need to convert it back to an SV and
+ * place it back in a refernce. We have to do this because the
+ * reference we would be passed at runtime could be reaped by garbage
+ * collection before we make the callback */
+ prompt_func = newRV_inc(INT2PTR(SV *,baton));
+ if (!SvROK(prompt_func) && SvTYPE(SvRV(prompt_func)) != SVt_PVCV)
+ return SVN_NO_ERROR;
+
+ /* Be nice and allocate the memory for the cred structure before passing it
+ * off to the perl space */
+ *cred = apr_pcalloc(pool, sizeof(**cred));
+ if (!*cred) {
+ croak("Could not allocate memory for cred structure");
+ }
+
+ perl_callback_thunk (CALL_SV,
+ prompt_func, &result,
+ "SS", *cred, credinfo,
+ pool, poolinfo);
+
+ /* Must clean up our reference we make or we'll leak */
+ SvREFCNT_dec(prompt_func);
+
+ return SVN_NO_ERROR;
+}
+
+svn_error_t *svn_swig_pl_thunk_ssl_client_cert_pw_prompt(
+ svn_auth_cred_ssl_client_cert_pw_t **cred,
+ void *baton,
+ apr_pool_t *pool)
+{
+ SV *prompt_func, *result;
+ swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *");
+ swig_type_info *credinfo = SWIG_TypeQuery(
+ "svn_auth_cred_ssl_client_cert_pw_t *");
+
+ /* baton here contains the pointer to the CV
+ * Before we can use it we need to convert it back to an SV and
+ * place it back in a refernce. We have to do this because the
+ * reference we would be passed at runtime could be reaped by garbage
+ * collection before we make the callback */
+ prompt_func = newRV_inc(INT2PTR(SV *,baton));
+ if (!SvROK(prompt_func) && SvTYPE(SvRV(prompt_func)) != SVt_PVCV)
+ return SVN_NO_ERROR;
+
+ /* Be nice and allocate the memory for the cred structure before passing it
+ * off to the perl space */
+ *cred = apr_pcalloc(pool, sizeof(**cred));
+ if (!*cred) {
+ croak("Could not allocate memory for cred structure");
+ }
+
+ perl_callback_thunk (CALL_SV,
+ prompt_func, &result,
+ "SS", *cred, credinfo,
+ pool, poolinfo);
+
+ /* Must clean up our reference we make or we'll leak */
+ SvREFCNT_dec(prompt_func);
+
+ return SVN_NO_ERROR;
+}
+
 /* default pool support */
 apr_pool_t *current_pool;
 
Index: subversion/bindings/swig/swigutil_pl.h
===================================================================
--- subversion/bindings/swig/swigutil_pl.h (revision 7861)
+++ subversion/bindings/swig/swigutil_pl.h (working copy)
@@ -112,7 +112,40 @@
                                   SV *perl_callbacks,
                                   apr_pool_t *pool);
 
+/* thunked simple_prompt callback function */
+svn_error_t *svn_swig_pl_thunk_simple_prompt (svn_auth_cred_simple_t **cred,
+ void *baton,
+ const char *realm,
+ const char *username,
+ apr_pool_t *pool);
 
+/* thunked username_prompt callback function */
+svn_error_t *svn_swig_pl_thunk_username_prompt (svn_auth_cred_username_t **cred,
+ void *baton,
+ const char *realm,
+ apr_pool_t *pool);
+
+/* thunked ssl_server_trust_prompt callback function */
+svn_error_t *svn_swig_pl_thunk_ssl_server_trust_prompt(
+ svn_auth_cred_ssl_server_trust_t **cred,
+ void *baton,
+ const char *realm,
+ int failures,
+ const svn_auth_ssl_server_cert_info_t *cert_info,
+ apr_pool_t *pool);
+
+/* thunked ssl_client_cert callback function */
+svn_error_t *svn_swig_pl_thunk_ssl_client_cert_prompt (
+ svn_auth_cred_ssl_client_cert_t **cred,
+ void *baton,
+ apr_pool_t *pool);
+
+/* thunked ssl_client_cert_pw callback function */
+svn_error_t *svn_swig_pl_thunk_ssl_client_cert_pw_prompt (
+ svn_auth_cred_ssl_client_cert_pw_t **cred,
+ void *baton,
+ apr_pool_t *pool);
+
 /* svn_stream_t helpers */
 svn_error_t *svn_swig_pl_make_stream (svn_stream_t **stream, SV *obj);
 SV *svn_swig_pl_from_stream (svn_stream_t *stream);
Index: subversion/bindings/swig/svn_client.i
===================================================================
--- subversion/bindings/swig/svn_client.i (revision 7861)
+++ subversion/bindings/swig/svn_client.i (working copy)
@@ -248,6 +248,144 @@
    any API, but svn_client_ls returns a hash of pointers to dirents. */
 %types(svn_dirent_t *);
 
+/* -----------------------------------------------------------------------
+ thunk the various authentication prompt functions
+*/
+%typemap(perl5, in) (svn_auth_simple_prompt_func_t prompt_func,
+ void *prompt_baton) {
+ $1 = svn_swig_pl_thunk_simple_prompt;
+
+ /* Because the callback occurs long after the function we're wrapping
+ it is likely that the rv or sv we are passed will be reaped by
+ perl before the callback happens. So we must get the cv for the
+ callback sub and store it in the baton */
+ if (SvROK((SV *)$input) && SvTYPE(SvRV((SV *)$input)) == SVt_PVCV) {
+ /* If the input is a coderef get the pointer to the cv it references
+ and store it in the baton*/
+ $2 = (void *)PTR2UV(SvRV($input));
+ } else if (SvPOK($input)) {
+ /* If the input is a string try to look up the cv by name and store
+ the pointer to it in the baton*/
+ char *cv_name = SvPV_nolen($input);
+ CV *cv = get_cv(cv_name,FALSE);
+ if (cv && SvTYPE((SV *)cv) == SVt_PVCV) {
+ $2 = (void *)PTR2UV(cv);
+ } else {
+ croak("No sub by that name");
+ }
+ } else {
+ croak("Not a CODE reference");
+ }
+}
+
+%typemap(perl5, in) (svn_auth_username_prompt_func_t prompt_func,
+ void *prompt_baton) {
+ $1 = svn_swig_pl_thunk_username_prompt;
+
+ /* Because the callback occurs long after the function we're wrapping
+ it is likely that the rv or sv we are passed will be reaped by
+ perl before the callback happens. So we must get the cv for the
+ callback sub and store it in the baton */
+ if (SvROK((SV *)$input) && SvTYPE(SvRV((SV *)$input)) == SVt_PVCV) {
+ /* If the input is a coderef get the pointer to the cv it references
+ and store it in the baton*/
+ $2 = (void *)PTR2UV(SvRV($input));
+ } else if (SvPOK($input)) {
+ /* If the input is a string try to look up the cv by name and store
+ the pointer to it in the baton*/
+ char *cv_name = SvPV_nolen($input);
+ CV *cv = get_cv(cv_name,FALSE);
+ if (cv && SvTYPE((SV *)cv) == SVt_PVCV) {
+ $2 = (void *)PTR2UV(cv);
+ } else {
+ croak("No sub by that name");
+ }
+ } else {
+ croak("Not a CODE reference");
+ }
+}
+
+%typemap(perl5, in) (svn_auth_ssl_server_trust_prompt_func_t prompt_func,
+ void *prompt_baton) {
+ $1 = svn_swig_pl_thunk_ssl_server_trust_prompt;
+
+ /* Because the callback occurs long after the function we're wrapping
+ it is likely that the rv or sv we are passed will be reaped by
+ perl before the callback happens. So we must get the cv for the
+ callback sub and store it in the baton */
+ if (SvROK((SV *)$input) && SvTYPE(SvRV((SV *)$input)) == SVt_PVCV) {
+ /* If the input is a coderef get the pointer to the cv it references
+ and store it in the baton*/
+ $2 = (void *)PTR2UV(SvRV($input));
+ } else if (SvPOK($input)) {
+ /* If the input is a string try to look up the cv by name and store
+ the pointer to it in the baton*/
+ char *cv_name = SvPV_nolen($input);
+ CV *cv = get_cv(cv_name,FALSE);
+ if (cv && SvTYPE((SV *)cv) == SVt_PVCV) {
+ $2 = (void *)PTR2UV(cv);
+ } else {
+ croak("No sub by that name");
+ }
+ } else {
+ croak("Not a CODE reference");
+ }
+}
+
+%typemap(perl5, in) (svn_auth_ssl_client_cert_prompt_func_t prompt_func,
+ void *prompt_baton) {
+ $1 = svn_swig_pl_thunk_ssl_client_cert_prompt;
+
+ /* Because the callback occurs long after the function we're wrapping
+ it is likely that the rv or sv we are passed will be reaped by
+ perl before the callback happens. So we must get the cv for the
+ callback sub and store it in the baton */
+ if (SvROK((SV *)$input) && SvTYPE(SvRV((SV *)$input)) == SVt_PVCV) {
+ /* If the input is a coderef get the pointer to the cv it references
+ and store it in the baton*/
+ $2 = (void *)PTR2UV(SvRV($input));
+ } else if (SvPOK($input)) {
+ /* If the input is a string try to look up the cv by name and store
+ the pointer to it in the baton*/
+ char *cv_name = SvPV_nolen($input);
+ CV *cv = get_cv(cv_name,FALSE);
+ if (cv && SvTYPE((SV *)cv) == SVt_PVCV) {
+ $2 = (void *)PTR2UV(cv);
+ } else {
+ croak("No sub by that name");
+ }
+ } else {
+ croak("Not a CODE reference");
+ }
+}
+
+%typemap(perl5, in) (svn_auth_ssl_client_cert_pw_prompt_func_t prompt_func,
+ void *prompt_baton) {
+ $1 = svn_swig_pl_thunk_ssl_client_cert_pw_prompt;
+
+ /* Because the callback occurs long after the function we're wrapping
+ it is likely that the rv or sv we are passed will be reaped by
+ perl before the callback happens. So we must get the cv for the
+ callback sub and store it in the baton */
+ if (SvROK((SV *)$input) && SvTYPE(SvRV((SV *)$input)) == SVt_PVCV) {
+ /* If the input is a coderef get the pointer to the cv it references
+ and store it in the baton*/
+ $2 = (void *)PTR2UV(SvRV($input));
+ } else if (SvPOK($input)) {
+ /* If the input is a string try to look up the cv by name and store
+ the pointer to it in the baton*/
+ char *cv_name = SvPV_nolen($input);
+ CV *cv = get_cv(cv_name,FALSE);
+ if (cv && SvTYPE((SV *)cv) == SVt_PVCV) {
+ $2 = (void *)PTR2UV(cv);
+ } else {
+ croak("No sub by that name");
+ }
+ } else {
+ croak("Not a CODE reference");
+ }
+}
+
 /* ----------------------------------------------------------------------- */
 
 
Index: subversion/bindings/swig/perl/Core.pm
===================================================================
--- subversion/bindings/swig/perl/Core.pm (revision 7861)
+++ subversion/bindings/swig/perl/Core.pm (working copy)
@@ -342,10 +346,54 @@
 
 =cut
 
+package _p_svn_auth_cred_simple_t;
+use SVN::Base qw(Core svn_auth_cred_simple_t_);
+
+=head2 svn_auth_cred_simple_t
+
+=cut
+
+package _p_svn_auth_cred_username_t;
+use SVN::Base qw(Core svn_auth_cred_username_t_);
+
+=head2 svn_auth_cred_username_t
+
+=cut
+
+package _p_svn_auth_cred_ssl_server_trust_t;
+use SVN::Base qw(Core svn_auth_cred_ssl_server_trust_t_);
+
+=head2 svn_auth_cred_ssl_server_trust_t
+
+=cut
+
+package _p_svn_auth_ssl_server_cert_info_t;
+use SVN::Base qw(Core svn_auth_ssl_server_cert_info_t_);
+
+=head2 svn_auth_ssl_server_cert_info_t
+
+=cut
+
+package _p_svn_auth_cred_ssl_client_cert_t;
+use SVN::Base qw(Core svn_auth_cred_ssl_client_cert_t_);
+
+=head2 svn_auth_cred_ssl_client_cert_t
+
+=cut
+
+package _p_svn_auth_cred_ssl_client_cert_pw_t;
+use SVN::Base qw(Core svn_auth_cred_ssl_client_cert_pw_t_);
+
+=head2 svn_auth_cred_ssl_client_cert_pw_t
+
+=cut
+
 =head1 AUTHORS
 
 Chia-liang Kao E<lt>clkao@clkao.orgE<gt>
 
+Ben Reser E<lt>ben@reser.orgE<gt>
+
 =head1 COPYRIGHT
 
 Copyright (c) 2003 CollabNet. All rights reserved.
 

-- 
Ben Reser <ben@reser.org>
http://ben.reser.org
"Conscience is the inner voice which warns us somebody may be looking."
- H.L. Mencken
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@subversion.tigris.org
For additional commands, e-mail: dev-help@subversion.tigris.org