Index: subversion/bindings/swig/swigutil_pl.c =================================================================== --- subversion/bindings/swig/swigutil_pl.c (revision 7997) +++ subversion/bindings/swig/swigutil_pl.c (working copy) @@ -233,6 +233,7 @@ typedef enum perl_func_invoker { CALL_METHOD, CALL_SV, + CALL_CV } perl_func_invoker_t; /* put the va_arg in stack and invoke caller_func with func. @@ -253,6 +254,7 @@ const char *fp = fmt; va_list ap; int count; + SV *func_sv; dSP ; ENTER ; @@ -302,6 +304,11 @@ case CALL_METHOD: count = call_method (func, G_SCALAR); break; + case CALL_CV: + func_sv = svn_swig_pl_get_sv_from_cv(func); + count = call_sv(func_sv, G_SCALAR); + SvREFCNT_dec(func_sv); /* Must clean up our ref or we'll leak */ + break; } SPAGAIN ; @@ -319,7 +326,56 @@ return SVN_NO_ERROR; } +/* Because callbacks can occur long after the function that sets the + * pointer to the callback it is possible that an sv or rv will be + * reaped by perl before the callback happens (e.g. the prompt + * functions). This function gets a cv from an sv or rv since + * cv values do not get reaped (even for anonymous subroutines). + * So we can safely store the cv in the baton for the callback. + * The function returns a void so that it can handle the typecasting + * necessary to put the result in a baton for us. */ +void * svn_swig_pl_get_cv_from_sv ( SV *sv) +{ + void *result = NULL; + + if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) { + /* If the input is a coderef get the pointer to the cv it + * references and return it. */ + result = (void *)PTR2UV(SvRV(sv)); + } else if (SvPOK(sv)) { + /* If the input is a string try to lookup up the cv by name + * and return the pointer to it. */ + char *cv_name = SvPV_nolen(sv); + CV *cv = get_cv(cv_name,FALSE); + if (cv && SvTYPE((SV *)cv) == SVt_PVCV) { + result = (void *)PTR2UV(cv); + } else { + croak("No sub by that name"); + } + } else { + croak("Not a CODE reference"); + } + return result; +} + +/* This function converts the cv back into an sv that we + * can actually pass to call_sv, see perl_get_cv_from_sv + * for details on why we need to do this. The function + * takes a void so that it can do the typcasting from + * the baton for us. * Note that you *MUST* call + * SvREFCNT_dec on the returned sv when done with it or + * you will leak it. + */ +SV * svn_swig_pl_get_sv_from_cv ( void *cv ) +{ + SV *result = newRV_inc(INT2PTR(SV *,cv)); + if (!SvROK(result) && SvTYPE(SvRV(result)) != SVt_PVCV) + croak("Couldn't convert cv to sv."); + + return result; +} + /*** Editor Wrapping ***/ /* this could be more perlish */ @@ -845,6 +901,147 @@ 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 *result; + swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *"); + swig_type_info *credinfo = SWIG_TypeQuery("svn_auth_cred_simple_t *"); + + /* 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_CV, + baton, &result, + "SssS", *cred, credinfo, + realm, username, pool, poolinfo); + + 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 *result; + swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *"); + swig_type_info *credinfo = SWIG_TypeQuery("svn_auth_cred_username_t *"); + + /* 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_CV, + baton, &result, + "SsS", *cred, credinfo, + realm, pool, poolinfo); + + 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 *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 *"); + + /* 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_CV, + baton, &result, + "SsiSS", *cred, credinfo, + realm, failures, + cert_info, cert_info_info, + pool, poolinfo); + + /* 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 *result; + swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *"); + swig_type_info *credinfo = SWIG_TypeQuery( + "svn_auth_cred_ssl_client_cert_t *"); + + /* 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_CV, + baton, &result, + "SS", *cred, credinfo, + pool, poolinfo); + + 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 *result; + swig_type_info *poolinfo = SWIG_TypeQuery("apr_pool_t *"); + swig_type_info *credinfo = SWIG_TypeQuery( + "svn_auth_cred_ssl_client_cert_pw_t *"); + + /* 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_CV, + baton, &result, + "SS", *cred, credinfo, + pool, poolinfo); + + 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 7997) +++ subversion/bindings/swig/swigutil_pl.h (working copy) @@ -89,6 +89,11 @@ SV *svn_swig_pl_array_to_list(const apr_array_header_t *array); SV *svn_swig_pl_ints_to_list(const apr_array_header_t *array); +/* Helpers for converting an sv to or from a cv */ +void * svn_swig_pl_get_cv_from_sv ( SV *sv); +SV * svn_swig_pl_get_sv_from_cv ( void *cv ); + + /* thunked log receiver function. */ svn_error_t * svn_swig_pl_thunk_log_receiver(void *py_receiver, apr_hash_t *changed_paths, @@ -122,7 +127,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 7997) +++ subversion/bindings/swig/svn_client.i (working copy) @@ -235,6 +235,39 @@ 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; + $2 = svn_swig_pl_get_cv_from_sv($input); +} + +%typemap(perl5, in) (svn_auth_username_prompt_func_t prompt_func, + void *prompt_baton) { + $1 = svn_swig_pl_thunk_username_prompt; + $2 = svn_swig_pl_get_cv_from_sv($input); +} + +%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; + $2 = svn_swig_pl_get_cv_from_sv($input); +} + +%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; + $2 = svn_swig_pl_get_cv_from_sv($input); +} + +%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; + $2 = svn_swig_pl_get_cv_from_sv($input); +} + /* ----------------------------------------------------------------------- */ Index: subversion/bindings/swig/perl/Core.pm =================================================================== --- subversion/bindings/swig/perl/Core.pm (revision 7997) +++ subversion/bindings/swig/perl/Core.pm (working copy) @@ -349,6 +349,48 @@ =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 Eclkao@clkao.orgE Index: subversion/bindings/swig/perl/Client.pm =================================================================== --- subversion/bindings/swig/perl/Client.pm (revision 7997) +++ subversion/bindings/swig/perl/Client.pm (working copy) @@ -12,13 +12,32 @@ my $ctx = SVN::_Client::new_svn_client_ctx_t (); $ctx->auth_baton (SVN::Core::auth_open - ([SVN::Client::get_simple_provider, - SVN::Client::get_username_provider])); + ([SVN::Client::get_simple_provider(), + SVN::Client::get_simple_prompt_provider(\&simple_prompt,2), + SVN::Client::get_username_provider()])); SVN::Client::cat (\*STDOUT, 'http://svn.collab.net/repos/svn/trunk/README', 'HEAD', $ctx); + sub simple_prompt { + my $cred = shift; + my $realm = shift; + my $default_username = shift; + my $pool = shift; + + print "Enter authentication info for realm: $realm\n"; + print "Username: "; + my $username = <>; + chop($username); + $cred->username($username); + print "Password: "; + my $password = <>; + chomp($password); + $cred->password($password); + } + + =head1 DESCRIPTION SVN::Client wraps the highest level of functions provided by