Index: openacs-4/packages/soap-gateway/soap-gateway.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/soap-gateway.info,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/soap-gateway.info 17 Oct 2004 05:51:39 -0000 1.1
@@ -0,0 +1,29 @@
+<?xml version="1.0"?>
+<!-- Generated by the OpenACS Package Manager -->
+
+<package key="soap-gateway" url="http://openacs.org/repository/apm/packages/SOAP-Gateway" type="apm_application">
+ <package-name>SOAP Gateway</package-name>
+ <pretty-plural>SOAP Gateway</pretty-plural>
+ <initial-install-p>f</initial-install-p>
+ <singleton-p>t</singleton-p>
+ <auto-mount>soap</auto-mount>
+
+ <version name="0.12d" url="http://openacs.org/repository/download/apm/SOAP-Gateway-0.12d.apm">
+ <owner url="mailto:williamb@byrnelitho.com">William Byrne</owner>
+ <owner url="http://www.weg.ee.usyd.edu.au/people/ncarroll">Nick Carroll</owner>
+ <summary>SOAP Gateway marshalls SOAP/HTTP to user defined services</summary>
+ <release-date>2004-10-04</release-date>
+
+ <provides url="soap-gateway" version="0.12d"/>
+
+ <callbacks>
+ </callbacks>
+ <parameters>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="SOAP_ENC_1_1" default="http://schemas.xmlsoap.org/soap/encoding/" description="Encoding for SOAP version 1.1."/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="SOAP_ENC_1_2" default="http://www.w3.org/2003/05/soap-encoding" description="Encoding for SOAP version 1.2."/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="SOAP_NS_1_1" default="http://schemas.xmlsoap.org/soap/envelope/" description="Namespace for SOAP version 1.1"/>
+ <parameter datatype="string" min_n_values="1" max_n_values="1" name="SOAP_NS_1_2" default="http://www.w3.org/2003/05/soap-envelope" description="Namespace for SOAP version 1.2."/>
+ </parameters>
+
+ </version>
+</package>
Index: openacs-4/packages/soap-gateway/lib/demo-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/lib/demo-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/lib/demo-procs.tcl 17 Oct 2004 05:51:51 -0000 1.1
@@ -0,0 +1,83 @@
+ad_library {
+
+ soap-gateway demo routines
+
+ @author William Byrne (WilliamB@ByrneLitho.com)
+
+}
+
+# create namespace
+namespace eval sg::demo {
+
+ # remove old procs
+ foreach p [info commands ::sg::demo::*] {
+
+ # remove
+ rename $p {}
+ }
+
+ # If there are any authentication requirements for a method in a service, add login
+ # and logout wrappers for soap::login and soap::logout methods.
+ #
+ # This will prevent the SOAP client transport from having to maintain session cookies
+ # across multiple client SOAP stubs. For example, a SOAP client can log into OpenACS using
+ # the 'workspace' service. Typically, the SOAP client will fetch the WSDL for the service
+ # and expose methods to the developer for calling upon methods specified in the WSDL.
+ # In the case of the 'workspace' service, the user would call the 'login' method. If
+ # successful, a session cookie is returned to the client and is maintained by the HTTP
+ # transport. If the user wishes to use the 'demo' service, another client SOAP stub
+ # would be created referencing the WSDL for the 'demo' service. Since the 'demo' SOAP
+ # stub is new, it won't have the session data maintained by the 'workspace' stub. There
+ # are certainly ways to share the session data; however, the process of doing so often
+ # turns into a science project.
+
+ # workspace login wrapper
+ ad_proc -public login {
+ user
+ password
+ } {
+ @author William Byrnec
+ @idl void Login(string user, string password)
+ } {
+
+ # call sg library
+ return [soap::login $user $password]
+ }
+
+
+ # workspace logout wrapper
+ ad_proc -public logout {
+ } {
+ @author William Byrne
+ @idl void Logout()
+ } {
+ # call sg logout
+ return [soap::logout]
+ }
+
+
+ # define calculate method
+ ad_proc -public calculate {
+ expr
+ } {
+
+ Performs an evaluation of the expression argument. The method attemps to provide some
+ safety by scanning for procedure notation. If detected, an exception is thrown.
+
+ @author William Byrne
+ @idl string Calculate(string expr)
+ } {
+
+ # detect proc bracket
+ if { [sting first \[ $expr] >= 0 } {
+ # throw
+ soap::fault::raise "procedure calls within expression are not allowed!"
+ }
+
+ # calculate
+ return [expr $expr]
+
+ }
+
+
+}
Index: openacs-4/packages/soap-gateway/lib/interop-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/lib/interop-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/lib/interop-procs.tcl 17 Oct 2004 05:51:51 -0000 1.1
@@ -0,0 +1,116 @@
+ad_library {
+
+ soap-gateway interop routines
+
+ @author William Byrne (WilliamB@ByrneLitho.com)
+
+}
+
+# set up interop namespace
+namespace eval sg::interop {
+
+ # remove old procs
+ foreach p [info commands ::sg::interop::*] {
+
+ # remove
+ rename $p {}
+ }
+
+ ad_proc -public login {
+ user
+ password
+ } {
+ Logs the user into OpenACS. The <em>user</em> and <em>password</em> arguments
+ correspond to the user/password values specified during user registration. The
+ HTTP transport used for the SOAP Envelope must support cookies for session based
+ RPC; otherwise, the user will be limited WSDL functions that expose 'invoke'
+ privileges to 'public'.
+
+ @author William Byrne
+ @idl void Login(string user, string password)
+ } {
+
+ # call sg library
+ return [soap::login $user $password]
+ }
+
+ ad_proc -public logout {
+ } {
+ Logs the current user session out of OpenACS.
+
+ @author William Byrne
+ @idl void Logout()
+ } {
+ # call sg library
+ return [soap::logout]
+ }
+
+ ad_proc -public echo_string {
+ data
+ } {
+ @author William Byrne
+ @idl string EchoString(string data)
+ } {
+
+ # return test data
+ return $data
+
+ }
+
+ ad_proc -public echo_integer {
+ data
+ } {
+ @author William Byrne
+ @idl int EchoInteger(int data)
+ } {
+
+ # return test data
+ return $data
+
+ }
+
+ ad_proc -public echo_float {
+ data
+ } {
+ @author William Byrne
+ @idl float EchoFloat(float data)
+ } {
+
+ # return test data
+ return $data
+
+ }
+
+ ad_proc -public echo_long {
+ data
+ } {
+ @author William Byrne
+ @idl long EchoLong(long data)
+ } {
+ # return test data
+ return $data
+
+ }
+
+ ad_proc -public echo_int64 {
+ data
+ } {
+ @author William Byrne
+ @idl __int64 EchoInt64(__int64 data)
+ } {
+ # return test data
+ return $data
+
+ }
+
+ ad_proc -public echo_void {
+ } {
+ @author William Byrne
+ @idl void EchoVoid()
+ } {
+
+ # return nothing
+
+ }
+
+}
Index: openacs-4/packages/soap-gateway/lib/workspace-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/lib/workspace-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/lib/workspace-procs.tcl 17 Oct 2004 05:51:51 -0000 1.1
@@ -0,0 +1,220 @@
+ad_library {
+
+ The <em>workspace</em> service provides a set of user workspace functions that
+ include the ability to log in and out of the OpenACS system. In order to take
+ advantage of session based SOAP RPC, the HTTP transport used by the client must
+ support cookies; otherwise, the user will be limited to methods that have
+ <em>invoke</em> privileges on the <em>Public</em> user.
+
+ @author William Byrne (WilliamB@ByrneLitho.com)
+
+}
+
+# set up workspace namespace and exports
+namespace eval sg::workspace {
+
+ # remove old procs
+ foreach p [info commands ::sg::workspace::*] {
+
+ # remove
+ rename $p {}
+ }
+
+
+ ad_proc -public login {
+ user
+ password
+ } {
+ Logs the user into OpenACS. The <em>user</em> and <em>password</em> arguments
+ correspond to the user/password values specified during user registration. The
+ HTTP transport used for the SOAP Envelope must support cookies for session based
+ RPC; otherwise, the user will be limited WSDL functions that expose 'invoke'
+ privileges to 'public'.
+
+ @author William Byrne
+ @idl void Login(string user, string password)
+ } {
+
+ # call soap::login procedure
+ return [soap::login $user $password]
+ }
+
+ ad_proc -public logout {
+ } {
+ Logs the current user session out of OpenACS.
+
+ @author William Byrne
+ @idl void Logout()
+ } {
+
+ # call sg logout
+ return [soap::logout]
+ }
+
+ ad_proc -public set_name {
+ firstname
+ lastname
+ } {
+ Changes the <em>firstname</em> and <em>lastname</em> of the user specified during the 'login' operation.
+
+ @author William Byrne
+ @idl void SetName(string firstname, string lastname)
+ } {
+
+ # get user
+ set user_id [ad_conn user_id]
+
+ # require write permission on user
+ soap::server::require_permission $user_id write
+
+ # verify args ???
+
+ db_dml {} "update persons
+ set first_names = :firstname,
+ last_name = :lastname
+ where person_id = :user_id"
+
+ }
+
+ ad_proc -public get_name {
+ } {
+ Returns the first and last name of the user currently logged in.
+
+ @author William Byrne
+ @idl string GetName()
+ } {
+
+ # get user
+ set user_id [ad_conn user_id]
+
+ # require write permission on user
+ soap::server::require_permission $user_id read
+
+ db_1row {} {
+ select first_names, last_name, email,
+ case when url is null then 'http://' else url end as url,
+ screen_name
+ from cc_users
+ where user_id=:user_id
+ }
+
+ # return name
+ return [string trim "$first_names $last_name"]
+
+ }
+
+ ad_proc -private has_bio {
+ user_id
+ {data {}}
+ } {
+ Utility procedure that returns whether user has bio record
+
+ @author William Byrne
+ } {
+
+ # grafted from subsite
+ set retval [db_0or1row grab_bio "select attr_value as bio_old
+ from acs_attribute_values
+ where object_id = :user_id
+ and attribute_id =
+ (select attribute_id
+ from acs_attributes
+ where object_type = 'person'
+ and attribute_name = 'bio')"]
+
+ # test
+ if { $data != {} } {
+
+ # go up one frame
+ upvar $data bio
+
+ if [soap::server::lib::true $retval] {
+
+ # set it
+ set bio $grab_bio
+
+ } else {
+
+ # clear it
+ set bio {}
+
+ }
+
+ }
+
+ # return status
+ return $retval
+ }
+
+ ad_proc -public get_bio {
+ } {
+ Returns the users biography.
+
+ @author William Byrne
+ @idl string GetBio()
+
+ } {
+
+ # get user
+ set user_id [ad_conn user_id]
+
+ # require write permission on user
+ soap::server::require_permission $user_id read
+
+ # has bio will fill optional data arg with biography
+ has_bio $user_id bio
+
+ # return bio
+ return $bio
+
+ }
+
+ ad_proc -public set_bio {
+ bio
+ } {
+ Updates the users biography.
+
+ @author William Byrne
+ @idl void SetBio(string bio)
+
+ } {
+
+ # get user
+ set user_id [ad_conn user_id]
+
+ # require write permission on user
+ soap::server::require_permission $user_id read
+
+ # verify length
+ soap::check_str_len $bio 4000 "Your biography is too long. Please limit it to 4000 characters"
+
+ # has bio ?
+ if [has_bio $user_id] {
+
+ # grafted from subsite - update
+ db_dml update_bio "update acs_attribute_values
+ set attr_value = :bio
+ where object_id = :user_id
+ and attribute_id =
+ (select attribute_id
+ from acs_attributes
+ where object_type = 'person'
+ and attribute_name = 'bio')"
+
+
+ } else {
+
+ # grafted from subsite - insert
+ db_dml insert_bio "insert into acs_attribute_values
+ (object_id, attribute_id, attr_value)
+ values
+ (:user_id, (select attribute_id
+ from acs_attributes
+ where object_type = 'person'
+ and attribute_name = 'bio'), :bio)"
+
+ }
+
+ }
+
+}
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/sql/postgresql/soap-gateway-create.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/sql/postgresql/soap-gateway-create.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/sql/postgresql/soap-gateway-create.sql 17 Oct 2004 05:51:52 -0000 1.1
@@ -0,0 +1,571 @@
+-- packages/soap-gateway/sql/postgresql/soap-gateway-create.sql
+--
+-- @author WilliamB@ByrneLitho.com
+-- @creation-date 2002-12-22
+-- @cvs-id $Id: soap-gateway-create.sql,v 1.1 2004/10/17 05:51:52 ncarroll Exp $
+--
+--
+
+-- clear existing
+--\i soap-gateway-drop.sql
+--\q
+create function inline_0 ()
+returns integer as '
+begin
+ PERFORM acs_object_type__create_type (
+ ''wsdl_namespace'', -- object_type
+ ''WSDL Namespace'', -- pretty_name
+ ''WSDL Namespaces'', -- pretty_plural
+ ''acs_object'', -- supertype
+ ''sg_namespaces'', -- table_name
+ ''namespace_id'', -- id_column
+ null, -- package_name
+ ''f'', -- abstract_p
+ null, -- type_extension_table
+ ''sg_namespaces__name'' -- name_method
+ );
+
+ return 0;
+end;' language 'plpgsql';
+
+select inline_0 ();
+
+drop function inline_0 ();
+
+create function inline_1 ()
+returns integer as '
+begin
+ PERFORM acs_object_type__create_type (
+ ''wsdl_method'', -- object_type
+ ''WSDL Method'', -- pretty_name
+ ''WSDL Methods'', -- pretty_plural
+ ''acs_object'', -- supertype
+ ''sg_methods'', -- table_name
+ ''method_id'', -- id_column
+ null, -- package_name
+ ''f'', -- abstract_p
+ null, -- type_extension_table
+ ''sg_methods__name'' -- name_method
+ );
+
+ return 0;
+end;' language 'plpgsql';
+
+select inline_1 ();
+
+drop function inline_1 ();
+
+-- define invoke moniker
+create view sg_invoke_moniker as
+ select 'invoke' as invoke from dual;
+
+create function inline_2 ()
+returns integer as '
+declare
+ v_invoke varchar;
+begin
+ select invoke into v_invoke from sg_invoke_moniker;
+
+ -- create privileges
+ perform acs_privilege__create_privilege(v_invoke);
+
+ -- bind privileges to global names
+ perform acs_privilege__add_child(''admin'',v_invoke);
+
+ return 0;
+end;' language 'plpgsql';
+select inline_2();
+drop function inline_2();
+
+
+
+create table sg_namespaces (
+ namespace_id integer
+ constraint sg_namespaces_namespace_id_fk
+ references acs_objects(object_id)
+ constraint sg_namespaces_namespace_id_pk
+ primary key,
+ service varchar(255)
+ constraint sg_namespaces_service_nn
+ not null unique check(trim(service) <> ''),
+ uri varchar(255)
+ constraint sg_namespaces_uri_nn
+ not null,
+ dirty boolean
+ default 't'
+ constraint sg_namespaces_dirty_nn
+ not null,
+ notes varchar(1024)
+);
+
+create index sg_namespaces_idx1 on sg_namespaces(service);
+
+create table sg_methods (
+ method_id integer
+ constraint sg_methods_method_id_fk
+ references acs_objects(object_id)
+ constraint sg_methods_namespace_id_pk
+ primary key,
+ namespace_id integer
+ constraint sg_methods_namespace_id_fk
+ references sg_namespaces(namespace_id),
+ method varchar(255)
+ constraint sg_methods_method_nn
+ not null check(trim(method) <> ''),
+ idl varchar(255)
+ constraint sg_methods_idl_nn
+ not null,
+ idl_style varchar(32)
+ constraint sg_methods_idl_style_nn
+ not null,
+ proc varchar(255)
+ constraint sg_methods_proc_nn
+ not null,
+ notes varchar(1024)
+);
+
+-- oddity fixup for lower case on index
+create function sg_unique(integer,varchar)
+returns text as '
+begin
+ return '''' || $1 || ''-'' || lower($2);
+end;' language 'plpgsql' with(iscachable);;
+
+
+create unique index sg_methods_idx1 on sg_methods(sg_unique(namespace_id, method));
+
+
+create table sg_libraries (
+ library_id integer not null primary key,
+ path varchar(255) not null unique
+);
+
+--
+-- sequences
+--
+
+create sequence sg_library_id_seq start 1000;
+
+--
+-- functions
+--
+
+-- get namespace id
+create function sg_namespace__get_id(varchar)
+returns integer as '
+declare
+ p_service alias for $1;
+
+ v_namespace_id sg_namespaces.namespace_id%type;
+begin
+
+ -- nullify
+ v_namespace_id = null;
+
+ -- get namespace count for id
+ select into v_namespace_id namespace_id
+ from sg_namespaces
+ where service = p_service;
+
+ -- fix up
+ if v_namespace_id is null then
+ v_namespace_id = -1;
+ end if;
+
+ -- return object id
+ return v_namespace_id;
+
+end;' language 'plpgsql';
+
+-- create new namespace
+create function sg_namespace__new(varchar, varchar, varchar, timestamptz, integer, varchar, integer)
+returns integer as '
+declare
+ p_service alias for $1;
+ p_uri alias for $2;
+ p_notes alias for $3;
+
+ p_creation_date alias for $4; -- default now()
+ p_creation_user alias for $5;
+ p_creation_ip alias for $6;
+ p_context_id alias for $7;
+
+ v_namespace_id sg_namespaces.namespace_id%type;
+begin
+
+ -- create new base object
+ v_namespace_id := acs_object__new (
+ null,
+ ''wsdl_namespace'',
+ p_creation_date,
+ p_creation_user,
+ p_creation_ip,
+ p_context_id
+ );
+
+ -- add to namespace table
+ insert into sg_namespaces
+ (namespace_id, service, uri, dirty, notes)
+ values
+ (v_namespace_id, p_service, p_uri, ''t'', p_notes);
+
+ -- create admin permission
+ PERFORM acs_permission__grant_permission(
+ v_namespace_id,
+ p_creation_user,
+ ''admin''
+ );
+
+ -- return new object id
+ return v_namespace_id;
+
+end;' language 'plpgsql';
+
+create function sg_namespace__update(integer, varchar, varchar, varchar)
+returns integer as '
+declare
+ p_namespace_id alias for $1;
+ p_service alias for $2;
+ p_uri alias for $3;
+ p_notes alias for $4;
+
+begin
+
+ -- update row values
+ update sg_namespaces
+ set
+ service = p_service,
+ uri = p_uri,
+ dirty = ''t'',
+ notes = p_notes
+ where
+ namespace_id = p_namespace_id;
+
+ -- return something
+ return 0;
+
+end;' language 'plpgsql';
+
+-- check namespace id
+create function sg_namespace__exists(integer)
+returns integer as '
+declare
+ p_namespace_id alias for $1;
+ v_record record;
+begin
+
+ -- get namespace count for id
+ select into v_record count(*)
+ from sg_namespaces
+ where namespace_id = p_namespace_id;
+
+ -- test
+ return v_record.count;
+
+end;' language 'plpgsql';
+
+-- remove namespace and child methods
+create function sg_namespace__delete (integer)
+returns integer as '
+declare
+ p_namespace_id alias for $1;
+ v_object_rec record;
+begin
+
+ -- verify id
+ if sg_namespace__exists(p_namespace_id) = 0 then
+ raise EXCEPTION ''Invalid namespace id: %'', p_namespace_id;
+ end if;
+
+ -- clean up permissions for namespace methods
+ delete from acs_permissions
+ where object_id in (
+ select method_id from sg_methods
+ where namespace_id = p_namespace_id
+ );
+
+ -- clean up permissions for namespace
+ delete from acs_permissions
+ where object_id = p_namespace_id;
+
+ -- remove method objects
+ for v_object_rec in select method_id from sg_methods where namespace_id = p_namespace_id
+ loop
+ perform acs_object__delete( v_object_rec.method_id );
+ end loop;
+
+ PERFORM acs_object__delete(p_namespace_id);
+
+ -- remove methods
+ delete from sg_methods
+ where namespace_id = p_namespace_id;
+
+ -- remove namespace
+ delete from sg_namespaces
+ where namespace_id = p_namespace_id;
+
+ return 0;
+
+end;' language 'plpgsql';
+
+
+-- create new method
+create function sg_method__new(integer, varchar, varchar, varchar, varchar, varchar, timestamptz, integer, varchar, integer)
+returns integer as '
+declare
+ p_namespace_id alias for $1;
+ p_method alias for $2;
+ p_idl alias for $3;
+ p_idl_style alias for $4;
+ p_proc alias for $5;
+ p_notes alias for $6;
+
+ p_creation_date alias for $7; -- default now()
+ p_creation_user alias for $8;
+ p_creation_ip alias for $9;
+ p_context_id alias for $10;
+
+ v_method_id integer;
+begin
+
+ -- create new base object
+ v_method_id := acs_object__new (
+ null,
+ ''wsdl_method'',
+ p_creation_date,
+ p_creation_user,
+ p_creation_ip,
+ p_context_id
+ );
+
+ -- add to method table
+ insert into sg_methods
+ (method_id, namespace_id, method, idl, idl_style, proc, notes)
+ values
+ (v_method_id, p_namespace_id, p_method, p_idl, p_idl_style, p_proc, p_notes);
+
+ -- create admin permission
+ PERFORM acs_permission__grant_permission(
+ v_method_id,
+ p_creation_user,
+ ''admin''
+ );
+
+ -- return new object id
+ return v_method_id;
+
+end;' language 'plpgsql';
+
+-- update method
+create function sg_method__update(integer, varchar, varchar, varchar, varchar, varchar)
+returns integer as '
+declare
+ p_method_id alias for $1;
+ p_method alias for $2;
+ p_idl alias for $3;
+ p_idl_style alias for $4;
+ p_proc alias for $5;
+ p_notes alias for $6;
+
+begin
+
+ -- update row values
+ update sg_methods
+ set
+ method = p_method,
+ idl = p_idl,
+ idl_style = p_idl_style,
+ proc = p_proc,
+ notes = p_notes
+ where
+ method_id = p_method_id;
+
+ -- return something
+ return 0;
+
+end;' language 'plpgsql';
+
+-- check method id
+create function sg_method__exists(integer)
+returns integer as '
+declare
+ p_method_id alias for $1;
+ v_record record;
+begin
+
+ -- get method count for id
+ select into v_record count(*)
+ from sg_methods
+ where method_id = p_method_id;
+
+ -- test
+ return v_record.count;
+
+end;' language 'plpgsql';
+
+-- remove method
+create function sg_method__delete (integer)
+returns integer as '
+declare
+ p_method_id alias for $1;
+begin
+
+ -- verify id
+ if sg_method__exists(p_method_id) = 0 then
+ raise EXCEPTION ''Invalid method id: %'', p_method_id;
+ end if;
+
+
+ -- clean up permissions for method
+ delete from acs_permissions
+ where object_id = p_method_id;
+
+ -- remove method object
+ perform acs_object__delete(p_method_id);
+
+ -- remove methods
+ delete from sg_methods
+ where method_id = p_method_id;
+
+ return 0;
+
+end;' language 'plpgsql';
+
+-- create new library
+create function sg_library__new(varchar)
+returns integer as '
+declare
+ p_path alias for $1;
+
+ v_library_id sg_libraries.library_id%type;
+begin
+
+ -- create next val
+ v_library_id = nextval(''sg_library_id_seq'');
+
+ -- add to library table
+ insert into sg_libraries
+ (library_id, path)
+ values
+ (v_library_id, p_path);
+
+ -- return id
+ return v_library_id;
+
+end;' language 'plpgsql';
+
+-- update library
+create function sg_library__update(integer, varchar)
+returns integer as '
+declare
+ p_library_id alias for $1;
+ p_path alias for $2;
+begin
+
+ -- update row values
+ update sg_libraries
+ set
+ path = p_service
+ where
+ library_id = p_library_id;
+
+ -- return something
+ return 0;
+
+end;' language 'plpgsql';
+
+-- remove library
+create function sg_library__delete (integer)
+returns integer as '
+declare
+ p_library_id alias for $1;
+begin
+
+ -- remove
+ delete from sg_libraries
+ where library_id = p_library_id;
+
+ return 0;
+
+end;' language 'plpgsql';
+
+-- returns namespace name
+create function sg_namespaces__name (integer)
+returns varchar as '
+declare
+ id alias for $1;
+ v_name sg_namespaces.service%TYPE;
+begin
+ select service into v_name
+ from sg_namespaces
+ where namespace_id = id;
+
+ return v_name;
+end;' language 'plpgsql';
+
+-- returns method name
+create function sg_methods__name (integer)
+returns varchar as '
+declare
+ id alias for $1;
+ v_name sg_methods.method%TYPE;
+begin
+ select method into v_name
+ from sg_methods
+ where method_id = id;
+
+ return v_name;
+end;' language 'plpgsql';
+
+-- forces namespace to dirty state for WSDL regen
+create function sg_namespaces__dirty(integer)
+returns integer as '
+declare
+ id alias for $1;
+begin
+ update sg_namespaces
+ set dirty = ''t''
+ where namespace_id = id;
+ return 0;
+end;' language 'plpgsql';
+
+-- trigger functions
+create function sg_methods__itrg ()
+returns opaque as '
+begin
+ perform sg_namespaces__dirty(new.namespace_id);
+ return new;
+end;' language 'plpgsql';
+
+create function sg_methods__dtrg ()
+returns opaque as '
+begin
+ perform sg_namespaces__dirty(old.namespace_id);
+ return old;
+end;' language 'plpgsql';
+
+create function sg_methods__utrg ()
+returns opaque as '
+begin
+ perform sg_namespaces__dirty(new.namespace_id);
+ if new.namespace_id <> old.namespace_id then
+ perform sg_namespacs__dirty(old.namespace_id);
+ end if;
+ return old;
+end;' language 'plpgsql';
+
+-- create triggers
+create trigger sg_methods__itrg after insert on sg_methods
+for each row execute procedure sg_methods__itrg ();
+
+create trigger sg_methods__dtrg after delete on sg_methods
+for each row execute procedure sg_methods__dtrg ();
+
+create trigger sg_methods__utrg after update on sg_methods
+for each row execute procedure sg_methods__utrg ();
+
+-- post intallation configuration
+select sg_library__new('packages/soap-gateway/lib/workspace-procs.tcl') from dual;
+select sg_library__new('packages/soap-gateway/lib/interop-procs.tcl') from dual;
+
+
Index: openacs-4/packages/soap-gateway/sql/postgresql/soap-gateway-drop.sql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/sql/postgresql/soap-gateway-drop.sql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/sql/postgresql/soap-gateway-drop.sql 17 Oct 2004 05:51:52 -0000 1.1
@@ -0,0 +1,100 @@
+-- packages/soap-gateway/sql/postgresql/soap-gateway-drop.sql
+--
+-- @author WilliamB@ByrneLitho.com
+-- @creation-date 2002-12-22
+-- @cvs-id $Id: soap-gateway-drop.sql,v 1.1 2004/10/17 05:51:52 ncarroll Exp $
+--
+--
+
+--drop permissions
+delete from acs_permissions where object_id in (select method_id from sg_methods);
+delete from acs_permissions where object_id in (select namespace_id from sg_namespaces);
+delete from acs_permissions where object_id in (select object_id from acs_objects where object_type in ('wsdl_namespace','wsdl_method'));
+delete from acs_permissions where object_id in (select package_id from apm_packages where package_key in ('soap-gateway'));
+
+-- clear objects
+create function inline_0 ()
+returns integer as '
+declare
+ object_rec record;
+begin
+ for object_rec in select object_id from acs_objects where object_type in (''wsdl_namespace'',''wsdl_method'')
+ loop
+ perform acs_object__delete( object_rec.object_id );
+ end loop;
+
+ return 0;
+end;' language 'plpgsql';
+
+select inline_0 ();
+drop function inline_0 ();
+
+create function inline_2 ()
+returns integer as '
+declare
+ v_invoke varchar;
+begin
+ select invoke into v_invoke from sg_invoke_moniker;
+
+ -- unbind privileges to global names
+ perform acs_privilege__remove_child(''admin'', v_invoke);
+
+ -- drop privileges
+ perform acs_privilege__drop_privilege(v_invoke);
+
+
+ return 0;
+end;' language 'plpgsql';
+select inline_2();
+drop function inline_2();
+
+
+-- drop triggers
+drop trigger sg_methods__itrg on sg_methods;
+drop trigger sg_methods__dtrg on sg_methods;
+drop trigger sg_methods__utrg on sg_methods;
+
+-- drop functions
+drop function sg_namespace__get_id(varchar);
+drop function sg_namespace__new(varchar, varchar, varchar, timestamptz, integer, varchar, integer);
+drop function sg_namespace__update(integer, varchar, varchar, varchar);
+drop function sg_namespace__exists(integer);
+drop function sg_namespace__delete (integer);
+drop function sg_method__new(integer, varchar, varchar, varchar, varchar, varchar, timestamptz, integer, varchar, integer);
+drop function sg_method__update(integer, varchar, varchar, varchar, varchar, varchar);
+drop function sg_method__exists(integer);
+drop function sg_method__delete (integer);
+drop function sg_namespaces__name (integer);
+drop function sg_methods__name (integer);
+drop function sg_namespaces__dirty(integer);
+drop function sg_methods__itrg();
+drop function sg_methods__dtrg();
+drop function sg_methods__utrg();
+drop function sg_library__new(varchar);
+drop function sg_library__update(integer, varchar);
+drop function sg_library__delete(integer);
+drop function sg_unique(integer,varchar);
+
+-- drop tables
+drop table sg_methods;
+drop table sg_namespaces;
+drop table sg_libraries;
+
+-- drop sequences
+drop sequence sg_library_id_seq;
+
+-- drop views
+drop view sg_invoke_moniker;
+
+-- drop attributes
+
+-- drop type
+select acs_object_type__drop_type(
+ 'wsdl_namespace',
+ 't'
+ );
+select acs_object_type__drop_type(
+ 'wsdl_method',
+ 't'
+ );
+
Index: openacs-4/packages/soap-gateway/tcl/soap-fault-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-fault-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-fault-procs.tcl 17 Oct 2004 05:51:52 -0000 1.1
@@ -0,0 +1,239 @@
+ad_library {
+ Tcl API for SOAP Faults.
+
+ @author William Byrne (WilliamB@ByrneLitho.com)
+ @author Nick Carroll (ncarroll@ee.usyd.edu.au)
+ @creation-date 2004-09-24
+ @cvs-id $Id: soap-fault-procs.tcl,v 1.1 2004/10/17 05:51:52 ncarroll Exp $
+}
+
+
+namespace eval soap::fault {}
+
+
+ad_proc -public soap::fault::assert {
+ test
+ msg
+} {
+ @param test
+ @param msg
+} {
+ # calculate
+ if [catch {set test [uplevel expr $test] } ] {
+ # throw
+ soap::fault::raise "Assertion\ntest: $test\n$msg"
+ }
+
+ # test
+ if { [string is integer -strict $test] == 0 || $test == 0 } {
+ # throw
+ soap::fault::raise "Assertion\ntest: $test\n$msg"
+ }
+}
+
+
+ad_proc -public soap::fault::raise {
+ msg
+ {code 500}
+} {
+ @param msg
+ @param code Default code set to 500.
+} {
+
+ # throw
+ error "SOAP Gateway Error\n$msg" {} $code
+}
+
+
+ad_proc -public soap::fault::unauthorized {
+ {msg "Access Denied"}
+} {
+ @param msg
+} {
+
+ # throw
+ soap::fault::raise "$msg" 401
+}
+
+
+ad_proc -public soap::fault::unsupported {
+ msg
+} {
+ @param msg
+} {
+
+ # throw
+ soap::fault::raise "$msg" 501
+}
+
+
+ad_proc -private soap::fault::generate_fault {
+ msg
+ {ver 1.1}
+} {
+ Generates a fault response based on the specified message.
+
+ @param msg The message to be sent back to the client.
+ @param ver The version of SOAP that the message should be based on.
+ @return Returns a fault response SOAP message.
+} {
+ # get version namespace
+ set version [soap::server::get_version_namespace $ver]
+
+ # construct xml doc object
+ set doc [dom createDocument env:Envelope]
+
+ # create root node: "env:Envelope"
+ set env [$doc documentElement]
+
+ # define namespace atts into node
+ $env setAttribute xmlns:env $version
+
+ # create Body node - "env:Envelope/env:Body"
+ set body [$env appendChild [$doc createElement env:Body]]
+
+ # create Fault node - "env:Envelope/env:Body/env:Fault"
+ set fault [$body appendChild [$doc createElement env:Fault]]
+
+ # test version
+ if { $ver == "1.1" } {
+
+ # create faultcode node
+ # env:Envelope/env:Body/env:Fault/env:faultcode
+ $fault appendXML "<env:faultcode>env:Client</env:faultcode>"
+
+ # create faultstring node
+ # env:Envelope/env:Body/env:Fault/env:faultstring
+ $fault appendXML "<env:faultstring>$msg</env:faultstring>"
+
+ } else {
+
+ # do v1.2
+
+ # create Code node and Value as a sub node of Code
+ # env:Envelope/env:Body/env:Fault/env:Code
+ # env:Envelope/env:Body/env:Fault/env:Code/env:Value
+ $fault appendXML "
+ <env:Code>
+ <env:Value>env:Sender</env:Value>
+ </env:Code>"
+
+ # create Reason node
+ # env:Envelope/env:Body/env:Fault/env:Reason
+ # define lang attr into Reason node
+ $fault appendFromList [list env:Reason {xml:lang en-US} {}]
+ }
+
+ # render xml into result string
+ return [$env asXML]
+}
+
+ad_proc -private soap::fault::generate_misunderstood {
+ namespaces
+ {ver 1.1}
+} {
+ Generates a misunderstood fault response based on the
+ specified namespaces.
+
+ @param namespaces The message to be sent back to the client.
+ @param ver The version of SOAP that the message should be based on.
+ @return Returns a misunderstood fault response SOAP message.
+} {
+ # set envelope version
+ set version [soap::server::get_version_namespace $ver]
+
+ # construct xml doc object
+ set doc [dom createDocument env:Envelope]
+
+ # create root node: "env:Envelope"
+ set env [$doc documentElement]
+
+ # define namespace atts into node
+ $env setAttribute xmlns:env $version
+ $env setAttribute xmlns:flt http://www.w3.org/2003/05/soap-faults
+
+ # create Header node - "env:Envelope/env:Header"
+ set header [$env appendChild [$doc createElement env:Header]]
+
+ # loop through namespaces and add
+ foreach ns $namespaces {
+ # safety
+ if { [llength $ns] > 1 } {
+ # add child
+ set mu [$header appendChild [$doc createElement flt:Misunderstood]]
+
+ # get qname
+ set qname [lindex $ns 0]
+
+ # split off namespace prefix
+ set parts [split $qname :]
+
+ # test
+ if { [llength $parts] > 1 } {
+ # get prefix
+ set prefix [lindex $parts 0]
+
+ # get name
+ set name [lindex $parts 1]
+ } else {
+ # generate prefix
+ append auto x
+
+ # set prefix to auto
+ set prefix $auto
+
+ # set name to qname
+ set name $qname
+ }
+
+ # add name attr
+ $mu setAttribute qname "$prefix:$name"
+
+ # add namespace
+ $mu setAttribute "xmlns:$prefix" [lindex $ns 1]
+ }
+ }
+
+ # create Body node - "env:Envelope/env:Body"
+ set body [$env appendChild [$doc createElement env:Body]]
+
+ # create Fault node - "env:Envelope/env:Body/env:Fault"
+ set fault [$body appendChild [$doc createElement env:Fault]]
+
+ # test version
+ if { $ver == "1.1" } {
+
+ # create faaultcode node
+ #env:Envelope/env:Body/env:Fault/env:faultcode
+ $fault appendXML "<env:faultcode>env:MustUnderstand</env:faultcode>"
+
+ # create faultstring node
+ # env:Envelope/env:Body/env:Fault/env:faultstring
+ $fault appendXML "<env:faultstring>One or more mandatory headers not understood</env:faultstring>"
+
+ } else {
+
+ # do v1.2
+
+ # create Code node
+ # env:Envelope/env:Body/env:Fault/env:Code
+ # env:Envelope/env:Body/env:Fault/env:Code/env:Value
+ $fault appendXML "
+ <env:Code>
+ <env:Value>env:MustUnderstand</env:Value>
+ </env:Code>"
+
+ # create Reason node
+ # env:Envelope/env:Body/env:Fault/env:Reason
+ set reason [$fault appendChild [$doc createElement env:Reason]]
+
+ # define lang attr into Reason node
+ $reason setAttribute xml:lang "en-US"
+
+ # set message for env:Reason.
+ $reason appendChild [$doc createTextNode "One or more mandatory headers not understood"]
+ }
+
+ # render xml into result string
+ return [$env asXML]
+}
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/tcl/soap-init.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-init.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-init.tcl 17 Oct 2004 05:51:53 -0000 1.1
@@ -0,0 +1,10 @@
+ad_library {
+
+ soap-gateway init library routines
+
+ @author William Byrne (WilliamB@ByrneLitho.com)
+
+}
+
+# schedule a one time directory scan for service source files
+ad_schedule_proc -thread t -once t 5 soap::server::lib::boot_libraries
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/tcl/soap-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-procs-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-procs-postgresql.xql 17 Oct 2004 05:51:53 -0000 1.1
@@ -0,0 +1,51 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="soap::method_get_procs.select_procs">
+ <querytext>
+ select proc
+ from sg_methods
+ where namespace_id = :namespace_id
+ order by method_id
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::namespace_get_names.select_services">
+ <querytext>
+ select service from sg_namespaces;
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::package_id.select_pid">
+ <querytext>
+ select package_id from apm_packages where package_key = 'soap-gateway'
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::namespace_check.namespace_exists">
+ <querytext>
+ select sg_namespace__exists(:namespace_id);
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::method_check.method_exists">
+ <querytext>
+ select sg_method__exists(:method_id)
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::namespace_delete.namespace_delete">
+ <querytext>
+ select 0 + sg_namespace__delete(:namespace_id);
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::method_delete.delete_method">
+ <querytext>
+ select 0 + sg_method__delete(:method_id);
+ </querytext>
+ </fullquery>
+
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/tcl/soap-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-procs.tcl 17 Oct 2004 05:51:53 -0000 1.1
@@ -0,0 +1,852 @@
+ad_library {
+ SOAP utils API.
+
+ Based on William Byrne's soap-gateway implementation.
+
+ @author William Byrne (WilliamB@ByrneLitho.com)
+ @author Nick Carroll (ncarroll@ee.usyd.edu.au)
+ @creation-date 2004-09-24
+ @cvs-id $Id: soap-procs.tcl,v 1.1 2004/10/17 05:51:53 ncarroll Exp $
+}
+
+
+namespace eval soap {}
+
+# Libraries in the lib directory must run in the sg namespace.
+namespace eval sg {}
+
+
+ad_proc -public soap::check_str_len {
+ string
+ length
+ {warning {string is too long}}
+} {
+ Verifies the string does not exceed length
+
+ @param string
+ @param length
+ @param warning
+} {
+ if { [string length $string] > $length } {
+ # throw
+ soap::fault::raise $warning
+ }
+}
+
+
+# create login wrapper for sg services
+ad_proc -public soap::login {
+ user
+ password
+} {
+ @param user
+ @param password
+} {
+ # normalize id
+ set email [string tolower $user]
+
+ # search for
+ set result [db_0or1row user_login_user_id_from_email {
+ select user_id, member_state, email_verified_p
+ from cc_users
+ where email = :email}]
+
+ # good house keeping
+ db_release_unused_handles
+
+ # verify
+ if { $result == 0 } {
+ # rejected
+ soap::fault::unauthorized "Access Denied\n$email not registered"
+ }
+
+ # again
+ if { $member_state != "approved" || $email_verified_p == "f" } {
+ # rejected
+ soap::fault::unauthorized "Access Denied\nMember: $member_state\ne-mail: $email_verified_p"
+ }
+
+ # and again
+ if { ![ad_check_password $user_id $password] } {
+ # rejected
+ soap::fault::unauthorized "Access Denied\nInvalid user or password"
+ }
+
+ # is this necessary ???
+ ad_user_logout
+
+ # log user
+ ad_user_login -forever=1 $user_id
+
+ # return 0
+ return 0
+}
+
+
+# create logout wrapper for sg services
+ad_proc -public soap::logout {
+} {
+ @author William Byrne
+} {
+ # clear cookies
+ ad_user_logout
+}
+
+
+ad_proc -private soap::method_check {
+ method_id
+} {
+ @param method_id
+} {
+ # exec db
+ set exists [db_string method_exists {} -default 0]
+
+ # test result
+ if { $exists == 0 || [string is integer $exists] != 1 } {
+ # failed, throw
+ soap::fault::raise "invalid method id: $namespace_id"
+ }
+ # valid
+}
+
+
+ad_proc -public soap::namespace_delete {
+ namespace_id
+} {
+ @param namespace_id
+} {
+ db_exec_plsql namespace_delete {}
+}
+
+
+ad_proc -public soap::method_delete {
+ method_id
+} {
+ @param method_id
+} {
+ # db update
+ db_exec_plsql delete_method {}
+}
+
+
+ad_proc -public soap::package_id {
+ {-throw 1}
+} {
+ @author William Byrne
+} {
+ # try and get id
+ set pid [apm_package_id_from_key soap-gateway]
+
+ # test
+ if { $pid != 0 } {
+ # done
+ return $pid
+ }
+
+ # memoize got fed bad stuff - clear it
+ util_memoize_flush_regexp "apm_package_id_from_key_mem soap-gateway"
+
+ # try again
+ set pid [apm_package_id_from_key soap-gateway]
+
+ # test
+ if { $pid != 0 } {
+ # done
+ return $pid
+ }
+
+ # crap - get connection
+ set pid [ad_conn package_id]
+
+ # verify
+ if [string equal [apm_package_key_from_id $pid] soap-gateway] {
+ #done
+ return $pid
+ }
+
+ # how 'bout the db
+ set pid [db_string select_pid {} -default 0]
+
+ # test
+ if { $pid != 0 } {
+ # done
+ return $pid
+ }
+
+ # throw
+ if [soap::server::lib::true $throw] {
+ soap::fault::raise "Cannot get package id for soap-gateway"
+ }
+
+ # return error
+ return 0
+}
+
+
+ad_proc -private soap::get {
+ {-set sg_properties}
+ property
+} {
+ @param property
+} {
+ # check set
+ if ![nsv_exists $set $property] {
+ # return empty
+ return {}
+ }
+
+ # get em
+ return [nsv_get $set $property]
+}
+
+
+ad_proc -private soap::namespace_get_names {
+} {
+ @author William Byrne
+} {
+ # init
+ set names [list]
+
+ # loop through namespaces
+ db_foreach select_services {} {
+ # append name
+ lappend names $service
+ }
+
+ # return names
+ return $names
+}
+
+
+ad_proc -private soap::query_services {
+ {-unpublished 0}
+ {-published 1}
+
+} {
+ @author William Byrne
+} {
+
+ # get active services
+ set services [soap::namespace_get_names]
+
+ # test for request
+ if $unpublished {
+ # decl unpublished list
+ set unpub [list]
+
+ # create lower case services
+ set lowercase_services [string tolower $services]
+
+ # get all namespaces under ::sg
+ foreach service [namespace children ::sg] {
+ # get child portion of namespace only - skip
+ # '::sg::' portion of string
+ set child [namespace tail $service]
+
+ # search for existing
+ if { [lsearch $lowercase_services [string tolower $child]] < 0 } {
+ # add to unpublished list
+ lappend unpub $child
+ }
+ }
+
+ # want all
+ if $published {
+ # add to services
+ return [concat $services $unpub]
+ } else {
+ # return list
+ return $unpub
+ }
+ }
+
+ # return services list
+ return $services
+}
+
+
+ad_proc -private soap::get_idl_help {
+} {
+ @author William Byrne
+} {
+
+ # return simple instructions
+ set help {
+ <p style="margin-top:4px">
+ Use "C" style function syntax. Data type map:
+ <table width="100%">
+ <tr style="line-height:90%"><td><u><b>Data Type</b></u></td><td><u><b>XML Schema</b></u></td></tr>
+ <tr style="line-height:90%"><td>char, char[], string</td><td>xsd:string</td></tr>
+ <tr style="line-height:90%"><td>int, long</td><td>xsd:int</td></tr>
+ <tr style="line-height:90%"><td>float, double</td><td>xsd:double</td></tr>
+ <tr style="line-height:90%"><td>__int64</td><td>xsd:long</td></tr>
+ <tr style="line-height:90%"><td>void</td><td>-</td></tr>
+ </table>
+ </p>
+ }
+}
+
+
+ad_proc -private soap::check_symbol {
+ symbol
+} {
+ @param symbol
+} {
+
+ # setup reg expr
+ set r {(^[^a-zA-Z]*)([a-zA-Z][a-zA-Z0-9_]*)([^a-zA-Z0-9_]*$)}
+
+ # call
+ set e [regexp $r $symbol {} a b c]
+
+ # test - requiring symbol not to exceed 64 characters ???
+ if {
+ $e == 0 ||
+ [string length $a] > 0 ||
+ [string length $b] > 64 ||
+ [string length $c] > 0
+ } {
+ # no good
+ soap::fault::raise "Invalid symbol: '$symbol'"
+ }
+}
+
+
+ad_proc -private soap::service_from_uri {
+ uri
+} {
+ @author William Byrne
+} {
+
+ # expects format similar to that returned
+ # from soap::wsdl::build_namespace_uri
+
+ # skip protocol scheme
+ set offset [string first {://} $uri]
+
+ # found ?
+ if { $offset >= 0 } {
+ # strip scheme
+ set uri [string range $uri [expr $offset + 3] end]
+ }
+
+ # split sub domains and return first
+ return [llindex [split $uri .] 0]
+}
+
+
+ad_proc -private soap::get_base_url {
+} {
+ @author William Byrne
+} {
+
+ # calc href base
+ set base [ad_conn package_url]
+
+ # verify we're in a soap-gateway site
+ if { ![string equal [ad_conn package_key] "soap-gateway"] } {
+ # force to apm registration
+ set base [apm_package_url_from_key soap-gateway]
+ }
+
+ # test for problems
+ if { $base == {} } {
+ # force to install mode
+ set base {/soap/}
+ }
+
+ # return it
+ return $base
+}
+
+
+ad_proc -private soap::get_doc_elements {
+ {-service {}}
+ proc
+} {
+ @param proc
+} {
+ # test for service arg
+ if { $service != {} } {
+ # build full path
+ set proc [format "::sg::%s::%s" $service $proc]
+ }
+
+ # try and get elements
+ if [catch {
+ # try
+ set elements [nsv_get api_proc_doc $proc]
+ }] {
+ # failed - strip off leading namespace qualifier
+ set elements [nsv_get api_proc_doc [string range $proc 2 end]]
+ }
+
+ # return elements
+ return $elements
+}
+
+
+ad_proc -private soap::get_source_procs {
+ {-private 0}
+ {-local 0}
+ service
+} {
+ Returns a list of procedures within the tcl namespace
+ formulated by sg::<service>::*
+
+ @param service
+} {
+ # decl unpublished list
+ set procs [list]
+
+ # safe fetch
+ catch {
+ # get methods
+ set procs [info commands [format "::sg::%s::*" $service]]
+ }
+
+ # decl result
+ set result [list]
+
+ # loop through source procs
+ foreach proc $procs {
+
+ # test for public
+ set public 0
+
+ # safe
+ catch {
+
+ # get proc doc elements
+ array set doc_elements [nsv_get api_proc_doc \
+ [string range $proc 2 end]]
+
+ # assign
+ set public $doc_elements(public_p)
+ }
+
+ # test
+ if { $public || $private } {
+ # test for local (no namespace)
+ if [soap::server::lib::true $local] {
+ # get last element after ::
+ regexp {([^:]+$)} $proc {} proc
+ }
+ # add to list
+ lappend result $proc
+ }
+ }
+
+ # return procs
+ return $result
+}
+
+
+ad_proc -private soap::get_source_idl {
+ proc
+} {
+ Returns the idl of a procedure. If the procedure exists,
+ an attempt is made to return @idl description. If @idl doesn't
+ exists, the idl is formulated from the procedures args. If
+ the procedure doesn't exists, an empty value is returned.
+
+ @param proc
+} {
+ # build formal name
+ set formal $proc; #[format "::sg::%s::%s" $service $proc]
+
+ # verify
+ if { [info commands $formal] == {} } {
+ # let's return empty string to signal error
+ soap::fault::raise "Cannot get idl for invalid procedur: $proc"
+ }
+
+ # decl idl
+ set idl {}
+
+ # safe
+ catch {
+ # get the documentenation array for the method
+ array set doc_elements [soap::get_doc_elements $formal]
+
+ # get the @idl value and remove curlies via 'join'
+ set idl [join $doc_elements(idl)]
+ }
+
+ # test idl
+ if { $idl == {} } {
+
+ # build from tcl info
+
+ # decl temp
+ set args2 {}
+
+ # the default idl will always return a string
+ # and each arg will be type string
+ foreach arg [info args $formal] {
+
+ # first time
+ if { $args2 == {} } {
+ # assign
+ set args2 "string $arg"
+ } else {
+ # add to
+ append args2 ", string $arg"
+ }
+ }
+
+ # remove namespace from proc
+ set proc [namespace tail $proc]
+
+ # finish
+ set idl [format "string %s(%s)" $proc $args2]
+ }
+
+ # return whatever we got
+ return $idl
+}
+
+
+ad_proc -private soap::get_source_idls {
+ service
+} {
+ Returns a list of idls for public procedures defined
+ within the sg::<service>:: namespace.
+
+ @see soap::get_source_idl
+ @param service
+} {
+ # get source procs for service
+ set procs [soap::get_source_procs $service]
+
+ # decl result list
+ set result [list]
+
+ # loop though procs
+ foreach proc $procs {
+ # get idl for proc
+ lappend result [soap::get_source_idl $proc]
+ }
+
+ # return list
+ return $result
+}
+
+
+ad_proc -private soap::method_get_procs {
+ namespace_id
+} {
+ @param namespace_id
+} {
+ # init
+ set procs [list]
+
+ db_foreach select_procs {} {
+ # append method proc
+ lappend procs $proc
+ }
+
+ # return methods
+ return $procs
+}
+
+
+ad_proc -private soap::diff_methods {
+ {-same 0}
+ service
+} {
+ Compares the published service methods to those in the source file
+ @param service
+} {
+ # decl unpublished list
+ set procs [soap::get_source_procs $service]
+
+ # decl published list
+ set methods [list]
+ set idls [list]
+
+ # get namespace id
+ set nid [soap::server::namespace_get_id $service]
+
+ # verify
+ if { $nid >= 0 } {
+
+ # get published method Tcl proc bindings (proc symbol in db);
+ set bindings [soap::method_get_procs $nid]
+
+ # and their idls
+ set idls [soap::wsdl::method_get_idls $nid]
+ }
+
+ # decl history list
+ set history [list]
+
+ # decl diff array
+ array set diffs [list]
+
+ # decl short names list for procs
+ set shorts [list]
+
+ # get idl parser expression for method - "C" syntax
+ set method_expr [soap::wsdl::get_style_parser_expr C]
+ set arg_expr [soap::wsdl::get_style_parser_expr -argpart 1 C]
+
+ # decl published list
+ set published [list]
+
+ # duplicate procs as they're duplicated in the WSDL
+ # database - this will ensure
+ # every entry in the database is tested. ??? weak
+
+ # decl dups
+ set dups [list]
+
+ # scan
+ foreach proc $procs {
+
+ # trim proc name
+ set short [namespace tail $proc]
+
+ # decl counter
+ set count 0
+
+ # get hits in db
+ foreach binding $bindings {
+
+ # compare
+ if [string equal $binding $short] {
+
+ # incr counter
+ incr count
+
+ # test for more than 1
+ if { $count > 1 } {
+
+ # add dup
+ lappend dups $proc
+ }
+ }
+ }
+ }
+
+ # update proc list with duplicated db method entries
+ foreach dup $dups {
+ # add to proc list
+ lappend procs $dup
+ }
+
+ # loop through source procs
+ foreach proc $procs {
+
+ # trim proc name
+ set short [namespace tail $proc]
+
+ # decl found
+ set found {}
+
+ # decl diff var
+ set diff {}
+
+ # get args for source proc (unpublished?)
+ set src_idl [soap::get_source_idl $proc]; #[info args $proc]
+
+ # decl uargs (unpublished)
+ set uargs {}
+
+ # invoke regexp to get args
+ if [regexp $method_expr $src_idl {} type src_meth argz] {
+
+ # loop through args
+ foreach arg [split $argz ,] {
+
+ # split
+ if [regexp $arg_expr $arg {} type name] {
+
+ # add to list
+ lappend uargs $name
+ }
+ }
+ } else {
+ # store for check below
+ set src_meth $short
+ }
+
+ # search published
+ foreach binding $bindings idl $idls {
+
+ # try
+ if [catch {
+
+ # test for case sensitive match
+ if [string equal $short $binding] {
+
+ # decl pargs
+ set pargs [list]
+
+ # invoke regexp to get args
+ if [regexp $method_expr $idl {} type method argz] {
+
+ # loop through args
+ foreach arg [split $argz ,] {
+
+ # split
+ if [regexp $arg_expr $arg {} type name] {
+
+ # add to list
+ lappend pargs $name
+ }
+ }
+
+ # park idl method name into found - used below
+ #set found $meth
+ } else {
+ # egats
+ continue
+ }
+
+ # set found indicator
+ set found $method
+
+ # compare unpublished args against published args
+
+ # compare
+ if { [llength $uargs] != [llength $pargs] } {
+
+ # note difference
+ set diff [list $uargs $pargs]
+
+ } else {
+
+ # compare arg names
+ foreach u $uargs p $pargs {
+
+ # compare
+ if ![string equal -nocase $u $p] {
+
+ # note difference
+ set diff [list $uargs $pargs]
+
+ # enough to note diff
+ break
+ }
+ }
+ }
+
+ # add to published list
+ lappend published $binding
+
+ # get idx of binding
+ set idx [lsearch $bindings $binding]
+
+ # remove from db lists
+ set bindings [lreplace $bindings $idx $idx]
+ set idls [lreplace $idls $idx $idx]
+ set methods [lreplace $methods $idx $idx]
+ }
+ } msg] {
+
+ # show error for diff
+ set diff "err $msg"
+ }
+
+ # test found
+ if { $found != {} } {
+ # stop scanning bindings for match - we found it
+ break
+ }
+ }
+
+ # found ?
+ if { $found != {} } {
+
+ # upper case found
+ set ufound [string toupper $found]
+
+ # check for duplicate
+ if { [lsearch $history $ufound] >= 0 } {
+ # mark as duplicate
+ set diffs($found) [list DUPL $uargs $pargs]
+ } else {
+ # differences ?
+ if { $diff != {} } {
+ # append to results list
+ set diffs($found) [list ARGS $uargs $pargs]
+ } elseif [soap::server::lib::true $same] {
+ # append procs that are identical - 'same' flag set
+ set diffs($found) [list SAME $uargs $pargs]
+ }
+
+ # add to history
+ lappend history $ufound
+ }
+ } else {
+
+ # upper case
+ set found [string toupper $src_meth]
+
+ # use full proc name to avoid potential clash
+ # with any db methods of same name
+
+ # check for duplicate
+ if { [lsearch $history $found] >= 0 } {
+ # mark as duplicate
+ set diffs($proc) [list DUPL $uargs {}]
+ } else {
+ # append missing - modify array key to avoid
+ # clash with db method of same name
+ set diffs($proc) [list UPUB $uargs {}]
+
+ # add to history
+ lappend history $found
+ }
+ }
+ }
+
+ # add remaining bindings
+ foreach binding $bindings idl $idls {
+
+ # invoke regexp to get args
+ if [regexp $method_expr $idl {} type method argz] {
+
+ # decl pargs
+ set pargs [list]
+
+ # loop through args
+ foreach arg [split $argz ,] {
+ # split
+ if [regexp $arg_expr $arg {} type name] {
+ # add to list
+ lappend pargs $name
+ }
+ }
+
+ # append missing
+ set diffs($method) [list ORPH {} $pargs]
+
+ } else {
+
+ # append error
+ set diffs($binding) [list ERR {} {}]
+ }
+ }
+
+ #return differences
+ return [array get diffs]
+}
+
+
+ad_proc -private soap::namespace_check {
+ namespace_id
+} {
+ @param namespace_id
+} {
+ # exec db
+ set exists [db_string namespace_exists {} -default 0]
+
+ # test result
+ if { $exists == 0 || [string is integer $exists] != 1 } {
+ # failed, throw
+ soap::fault::raise "invalid namespace id: $namespace_id"
+ }
+ # valid
+}
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/tcl/soap-server-lib-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-server-lib-procs-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-server-lib-procs-postgresql.xql 17 Oct 2004 05:51:53 -0000 1.1
@@ -0,0 +1,94 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="soap::server::lib::library_get_paths.select_lib_paths">
+ <querytext>
+ select path from sg_libraries;
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::lib::method_new.method_new">
+ <querytext>
+ select sg_method__new(
+ :namespace_id,
+ :method,
+ :idl,
+ :idl_style,
+ :proc,
+ :notes,
+ now(),
+ :user_id,
+ :peeraddr,
+ :package_id
+ );
+ </querytext>
+</fullquery>
+
+ <fullquery name="soap::server::lib::namespace_new.namespace_new">
+ <querytext>
+ select sg_namespace__new (
+ :service,
+ :uri,
+ :notes,
+ now(),
+ :user_id,
+ :peeraddr,
+ :package_id
+ ) from dual;
+ </querytext>
+ </fullquery>
+
+ <fullquery name="namespace_update">
+ <querytext>
+ select sg_namespace__update(
+ :namespace_id,
+ :service,
+ :uri,
+ :notes,
+ ) from dual;
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::lib::import_service.namespace_select">
+ <querytext>
+ select service, uri, notes
+ from sg_namespaces
+ where namespace_id = :nid
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::lib::method_update.method_update">
+ <querytext>
+
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::lib::library_new.library_new">
+ <querytext>
+ select sg_library__new(:path) from dual
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::lib::library_get_path.select_path">
+ <querytext>
+ select path
+ from sg_libraries
+ where library_id = :library_id
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::lib::library_delete.delete_library">
+ <querytext>
+ select 0 + sg_library__delete(:library_id)
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::lib::library_update.update_library">
+ <querytext>
+ select 0 + sg_library__update(:library_id,:path)
+ </querytext>
+ </fullquery>
+
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/tcl/soap-server-lib-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-server-lib-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-server-lib-procs.tcl 17 Oct 2004 05:51:53 -0000 1.1
@@ -0,0 +1,624 @@
+ad_library {
+
+ SOAP API for registering and handling TCL services located in the
+ library directory.
+
+ @author William Byrne (WilliamB@ByrneLitho.com)
+ @author Nick Carroll (ncarroll@ee.usyd.edu.au)
+}
+
+
+namespace eval soap::server::lib {}
+
+
+ad_proc -public soap::server::lib::library_new {
+ path
+} {
+ @param path
+} {
+ db_exec_plsql library_new {}
+}
+
+
+ad_proc -public soap::server::lib::library_update {
+ library_id
+ path
+} {
+ @param library_id
+ @param path
+} {
+ db_exec_plsql update_library {}
+}
+
+ad_proc -public soap::server::lib::library_delete {
+ library_id
+} {
+ @param library_id
+} {
+ db_exec_plsql delete_library {}
+}
+
+
+ad_proc -public soap::server::lib::library_get_path {
+ library_id
+} {
+ @param library_id
+} {
+ set path [db_string select_path {} -default {} ]
+
+ # return
+ return $path
+}
+
+
+ad_proc -private soap::server::lib::is_library_valid {
+ library
+} {
+ @param library
+} {
+
+ # get root without tail /
+ set root [file join [acs_root_dir]]
+
+ # test for directory
+ if [file isdirectory [file join $root $library]] {
+ # append wildcard
+ set library [file join $library *.tcl]
+ }
+
+ # scan glob list
+ foreach f [glob -nocomplain -directory $root $library] {
+ # verify extension
+ if ![string equal -nocase [file extension $f] {.tcl}] {
+ # skip it
+ continue
+ }
+ # yup
+ return 1
+ }
+ # clean
+ return 0
+}
+
+ad_proc -private soap::server::lib::is_library_dirty {
+ library
+} {
+ @author William Byrne
+} {
+ # get root without trailing /
+ set root [file join [acs_root_dir]]
+
+ # get len + 1 for eventual /
+ set len [expr [string length $root] + 1]
+
+ # test for directory
+ if [file isdirectory [file join $root $library]] {
+ # append wildcard
+ set library [file join $library *.tcl]
+ }
+
+ # scan glob list
+ foreach f [glob -nocomplain -directory $root $library] {
+ # verify extension
+ if ![string equal -nocase [file extension $f] {.tcl}] {
+ # skip it
+ continue
+ }
+
+ # get mtime
+ set mtime [file mtime $f]
+
+ # get short
+ set short [string range $f $len end]
+
+ # check to see if registered in loader
+ if ![nsv_exists apm_reload_watch $short] {
+ # remove from mtime
+ catch { nsv_unset apm_library_mtime $short }
+ }
+
+ # get property without root
+ set cached [soap::get -set apm_library_mtime $short]
+
+ # test
+ if { $cached == {} || $mtime != $cached } {
+ # dirty
+ return 1
+ }
+ }
+ # clean
+ return 0
+}
+
+
+ad_proc -private soap::server::lib::library_get_paths {
+} {
+ @author William Byrne
+} {
+ # init
+ set paths [list]
+
+ # loop through libraries
+ db_foreach select_lib_paths {} {
+ # append name
+ lappend paths $path
+ }
+
+ # return names
+ return $paths
+}
+
+
+ad_proc -public soap::server::lib::update_libraries {
+ {-stop 0}
+ {libraries [list]}
+} {
+ @author William Byrne
+} {
+ # get root without trailing /
+ set root [file join [acs_root_dir]]
+
+ # get len + 1 for eventual /
+ set len [expr [string length $root] + 1]
+
+ # loop through libraries
+ foreach lib $libraries {
+
+ # test for directory
+ if [file isdirectory [file join $root $lib]] {
+ # append wildcard
+ set lib [file join $lib *.tcl]
+ } elseif ![string equal -nocase [file extension $lib] {.tcl}] {
+ # skip it
+ continue
+ }
+
+ # scan glob list
+ foreach f [glob -nocomplain -directory $root $lib] {
+ # add to watch without root
+ soap::server::lib::watch -stop $stop [string range $f $len end]
+ }
+ }
+ # return something
+ return 1
+}
+
+
+ad_proc -private soap::server::lib::true {
+ value
+} {
+ @author William Byrne
+} {
+ # handle ints > 1 || < 0
+ if [string is integer $value] {
+ # eval
+ return [expr $value != 0 ? 1 : 0]
+ }
+
+ # empty value is false
+ return [expr [string length $value] > 0 && [string is true $value] ? 1 : 0]
+}
+
+
+ad_proc -public soap::server::lib::watch {
+ {-stop 0}
+ file
+} {
+ @author William Byrne
+} {
+ # setup result
+ set result 1
+
+ # test for stop
+ if [soap::server::lib::true $stop] {
+ # safe
+ if [catch {
+ # stop watch
+ nsv_unset apm_reload_watch $file
+ }] {
+ # egats
+ set result 0
+ }
+ # safe
+ catch {
+ # remove cache
+ nsv_unset apm_library_mtime $file
+ }
+
+ } else {
+ # add
+ apm_file_watch $file
+ }
+
+ # return status
+ return $result
+}
+
+
+ad_proc -public soap::server::lib::boot_libraries {
+} {
+ @author William Byrne
+} {
+ # get paths
+ set paths [soap::server::lib::library_get_paths]
+
+ # send to update
+ foreach lib $paths {
+ soap::server::lib::update_libraries $lib
+ }
+
+ # return something
+ return 1
+}
+
+
+ad_proc -private soap::server::lib::get_library_doc {
+ service
+} {
+ @param service
+} {
+ # get a command from namespace
+ set procs [info commands [format "::sg::%s" $service]]
+
+ # decl source path
+ set path {}
+
+ # any ?
+ if [llength $procs] {
+ # get first one
+ set proc [lindex $procs 0]
+
+ # safe
+ catch {
+ # get the documentenation array for the method
+ array set doc_elements [nsv_get api_proc_doc \
+ [format "::sg::%s::%s" $service $proc]]
+
+ # get script path
+ set path $doc_elements(script)
+ }
+ }
+
+ # check path
+ if { $path == {} } {
+
+ # try lib directory
+ set path "packages/soap-gateway/lib/[string tolower $service]-procs.tcl"
+ }
+
+ # decl result
+ set result {}
+
+ # try to get doc info from file
+ catch {
+ # get source file docs - force lower case convention
+ array set doc_elements [nsv_get api_library_doc $path]
+
+ # update and remove curlies
+ set result [join $doc_elements(main)]
+ }
+
+ # return whatever we got
+ return $result
+}
+
+
+ad_proc -public soap::server::lib::method_new {
+ namespace_id
+ method
+ idl
+ idl_style
+ proc
+ notes
+ user_id
+ peeraddr
+ package_id
+} {
+ @param namespace_id
+ @param method
+ @param idl
+ @param idl_style
+ @param proc
+ @param notes
+ @param user_id
+ @param peeraddr
+ @param package_id
+} {
+ # create new -
+ db_exec_plsql method_new {}
+}
+
+
+ad_proc -public soap::server::lib::namespace_new {
+ service
+ uri
+ notes
+ user_id
+ peeraddr
+ package_id
+} {
+ @param service
+ @param uri
+ @param notes
+ @param user_id
+ @param peeraddr
+ @param package_id
+} {
+ # db new
+ db_exec_plsql namespace_new {}
+}
+
+
+ad_proc -public soap::server::lib::namespace_update {
+ namespace_id
+ service
+ uri
+ notes
+} {
+ @param namespace_id
+ @param service
+ @param uri
+ @param notes
+} {
+ db_exec_plsql namespace_update {}
+}
+
+
+ad_proc -private soap::server::lib::get_proc_doc {
+ proc
+} {
+ @param proc
+} {
+ # decl result
+ set result {}
+
+ # safe
+ catch {
+
+ # remove sg namespace
+ if { [string equal -length 6 ::sg:: $proc] } {
+ # trim ::
+ set proc [string range $proc 2 end]
+ }
+
+ # get doc set for procedure
+ array set doc_elements [nsv_get api_proc_doc $proc]
+
+ # get main documentation and remove curlies
+ set result [join $doc_elements(main)]
+ }
+
+ # return procedure doc
+ return $result
+}
+
+
+ad_proc -private soap::server::lib::idl_to_xsd {
+ style
+ idl
+} {
+ @param style
+ @param idl
+} {
+ # verify style
+ if { [string compare -nocase $style "C"] != 0 } {
+
+ # not yet supported
+ soap::fault::unsupported "Unsupported IDL style: $style\n Use 'C'"
+
+ }
+
+ # set up regexp expression for "C" style function
+ set expr [soap::wsdl::get_style_parser_expr C]
+
+ # invoke regexp
+ regexp $expr $idl {} type method argz
+
+ # map type
+ set xtype [soap::wsdl::map_ctype_to_xtype $type]
+
+ # verify
+ if { [llength $xtype] > 1 } {
+
+ # not yet supported
+ soap::fault::unsupported "cannot spec non simple types: $type"
+
+ }
+
+ # setup arg list
+ set xargs [list]
+
+ # get arg parser expr
+ set expr [soap::wsdl::get_style_parser_expr -argpart 1 C]
+
+ # loop through args
+ foreach a [split $argz ,] {
+
+ # split arg type from its name
+ if ![regexp $expr $a {} typ nam] {
+
+ # format problem
+ error "unexpected argument format: $a"
+
+ }
+
+ # add arg to param order var
+ lappend order $nam
+
+ # map type
+ set xtype2 [soap::wsdl::map_ctype_to_xtype $typ]
+
+ # get component count
+ set cnt [llength $xtype2]
+
+ # test for simple
+ if { $cnt == 1 } {
+
+ # append to arg list
+ lappend xargs [list [lindex $xtype2 0] $nam]
+
+ } else {
+
+ # not yet supported
+ soap::fault::unsupported "cannot spec non simple types: $a, $xtype2"
+ }
+ }
+
+ # build return
+ return [list $xtype $method $xargs]
+}
+
+
+ad_proc -public soap::server::lib::method_update {
+ method_id
+ method
+ idl
+ idl_style
+ proc
+ notes
+} {
+ @param method_id
+ @param method
+ @param idl
+ @param idl_style
+ @param proc
+ @param notes
+} {
+ # update existing
+ db_exec_plsql method_update {}
+}
+
+
+ad_proc -private soap::server::lib::import_service {
+ {-force 0}
+ {-proc {}}
+ service
+} {
+ @param service
+} {
+ # set connection vars
+ set user_id [ad_conn user_id]
+ set peeraddr {}
+ set package_id [ad_conn package_id]
+
+ # verify workspace namespace
+ set nid [soap::server::namespace_get_id $service]
+
+ # test
+ if { $nid == -1 } {
+
+ # get doc
+ set notes [soap::server::lib::get_library_doc $service]
+
+ # create
+ soap::server::lib::namespace_new \
+ $service "http://$service.openacs.org/methods" \
+ $notes $user_id $peeraddr $package_id
+
+ # clear
+ unset notes
+
+ # get id
+ set nid [soap::server::namespace_get_id $service]
+
+ } elseif { $force } {
+
+ # query for namespace attributes
+ db_1row namespace_select {}
+
+ # get doc
+ set notes [soap::server::lib::get_library_doc $service]
+
+ # update with new notes
+ soap::server::lib::namespace_update $nid $service $uri $notes
+ }
+
+ # get public procs for namespace
+
+ # set method parameters - idl style
+ set idl_style {C}
+
+ # build procs list
+ set procs [soap::get_source_procs $service]
+
+ # test for optional proc arg
+ if { $proc != {} } {
+
+ # test for ns qualifier ??? (weak)
+ if ![string equal -length 6 $proc {::sg::}] {
+ # fix up
+ set proc [format "::sg::%s::%s" $service $proc]
+ }
+
+ # contained in list
+ if { [lsearch -exact $procs $proc] >= 0 } {
+ # use
+ set procs [list $proc]
+ } else {
+ # clear, not found
+ set procs [list]
+ }
+ }
+
+ # loop
+ foreach proc $procs {
+ # get idl
+ set idl [soap::get_source_idl $proc]
+
+ # get notes
+ set note [soap::server::lib::get_proc_doc $proc]
+
+ # try
+ if [catch {
+ # decompose IDL
+ set xsd [soap::server::lib::idl_to_xsd $idl_style $idl]
+ } msg] {
+ # report
+ soap::fault::raise "Error importing: $proc, idl: $idl\n$msg"
+ }
+
+ # get method name from idl
+ set method [lindex $xsd 1]
+
+ # remove namespace
+ set proc [namespace tail $proc]
+
+ # verify workspace method
+ set mid [soap::wsdl::method_get_id $nid $method]
+
+ # test
+ if { $mid == -1 } {
+ # create
+ soap::server::lib::method_new $nid $method $idl $idl_style \
+ $proc $note $user_id $peeraddr $nid
+
+ # test for 'login'
+ if [string equal -nocase $method "LOGIN"] {
+ # get method id
+ set mid [soap::wsdl::method_get_id $nid $method]
+
+ # verify
+ soap::fault::assert {$mid != -1} "Error retrieving 'login' method id: $method => $mid"
+
+ # get public
+ set public_id [acs_magic_object the_public]
+
+ # get invoke symbol
+ set invoke [soap::server::get_invoke_permission_moniker]
+
+ # grant invoke permission to public
+ permission::grant -party_id $public_id -object_id $mid -privilege $invoke
+
+ # verify
+ set ok [permission::permission_p -party_id $public_id -object_id $mid -privilege $invoke]
+ soap::fault::assert $ok "Error granting '$invoke' permission to public"
+ }
+ } elseif { $force } {
+ # update
+ error "soap::server::lib::method_update $mid $method $idl $idl_style $proc $note"
+ }
+ }
+
+ # return namespace id
+ return $nid
+}
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/tcl/soap-server-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-server-procs-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-server-procs-postgresql.xql 17 Oct 2004 05:51:53 -0000 1.1
@@ -0,0 +1,32 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="soap::server::namespace_get_id.namespace_id">
+ <querytext>
+ select sg_namespace__get_id(:service) from dual
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::service_name_exists_p.service_name">
+ <querytext>
+ select sg_namespace__get_id(:service) from dual
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::method_get_id_and_proc.method_id_proc">
+ <querytext>
+ select method_id || ' ' || proc
+ from sg_methods
+ where namespace_id = :namespace_id and
+ lower(method) = lower(:method)
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::server::get_invoke_permission_moniker.select_moniker">
+ <querytext>
+ select * from sg_invoke_moniker
+ </querytext>
+ </fullquery>
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/tcl/soap-server-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-server-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-server-procs.tcl 17 Oct 2004 05:51:54 -0000 1.1
@@ -0,0 +1,425 @@
+ad_library {
+ Tcl API for a SOAP Server.
+
+ Based on William Byrne's soap-gateway implementation.
+
+ @author William Byrne (WilliamB@ByrneLitho.com)
+ @author Nick Carroll (ncarroll@ee.usyd.edu.au)
+ @creation-date 2004-09-24
+ @cvs-id $Id: soap-server-procs.tcl,v 1.1 2004/10/17 05:51:54 ncarroll Exp $
+}
+
+namespace eval soap::server {}
+
+ad_proc -public soap::server::get_version_namespace {
+ ver
+} {
+ Returns the namespace for the specified SOAP version.
+
+ @param ver A SOAP version, eg 1.1 or 1.2.
+ @return Returns the namespace associated with the specified
+ version of SOAP.
+} {
+
+ switch $ver {
+ 1.1 {
+ # Namespace for SOAP 1.1
+ return [parameter::get -parameter "SOAP_NS_1_1"]
+ }
+ 1.2 {
+ # Namespace for SOAP 1.2
+ return [parameter::get -parameter "SOAP_NS_1_2"]
+ }
+ }
+
+ # return 1.1 as safety
+ return [parameter::get -parameter "SOAP_NS_1_1"]
+}
+
+ad_proc -public soap::server::get_version_encoding {
+ ver
+} {
+ Returns the encoding for the specified SOAP version.
+
+ @param ver A SOAP version, eg 1.1 or 1.2.
+ @return Returns the encoding associated with the specified
+ version of SOAP.
+} {
+ switch $ver {
+ 1.1 {
+ return [parameter::get -parameter "SOAP_ENC_1_1"]
+ }
+ 1.2 {
+ return [parameter::get -parameter "SOAP_ENC_1_2"]
+ }
+ }
+
+ # return 1.1 as safety
+ return [parameter::get -parameter "SOAP_ENC_1_1"]
+}
+
+ad_proc -public soap::server::get_url_params {
+} {
+ @author William Byrne
+} {
+ # try to get from target url
+ set request [ns_conn request]
+
+ # search for ?
+ set offset [string first "?" $request]
+
+ # test
+ if { $offset >= 0 } {
+
+ # fixup offset
+ incr offset
+
+ # find first space after query
+ set last [string first " " $request $offset]
+
+ # fixup
+ if { $last < 0 } {
+ set last end
+ } else {
+ incr last -1
+ }
+
+ # get query
+ set query [string range $request $offset $last]
+
+ } else {
+ # clear
+ set query {}
+ }
+ # return params as ns_set
+ return [ns_parsequery $query]
+}
+
+ad_proc -public soap::server::get_url_param {
+ param
+} {
+ @author William Byrne
+} {
+ # get params
+ set params [soap::server::get_url_params]
+
+ # return requested
+ return [ns_set get $params $param]
+}
+
+ad_proc -public soap::server::has_permission {
+ {-user_id {}}
+ object_id
+ privilege
+} {
+ @param object_id
+ @param privilege
+} {
+ # test user
+ if { $user_id == {} } {
+ # set to current user
+ set user_id [ad_conn user_id]
+ }
+
+ # return permission cache
+ return [permission::permission_p -party_id $user_id \
+ -object_id $object_id -privilege $privilege]
+}
+
+ad_proc -public soap::server::require_permission {
+ object_id
+ privilege
+} {
+ @param object_id
+ @param privilege
+} {
+ # check permission cache
+ if { ![soap::server::has_permission $object_id $privilege] } {
+ # deny
+ return [soap::fault::generate_error "Unauthorized: Access Denied"]
+ }
+}
+
+ad_proc -public soap::server::invoke {
+ env
+} {
+ Take the SOAP request and invoke the method on the server.
+
+ @param env The SOAP envelope sent from the client.
+ @return result wrapped in a SOAP response envelope and returned
+ to the client.
+} {
+
+ # Invoke in safe block
+ if {[catch {set result [soap::server::do_invoke $env]} err_msg]} {
+ # build fault
+ set result [soap::fault::generate_fault $err_msg]
+ }
+
+ # return envelope
+ return $result
+}
+
+
+ad_proc -private soap::server::do_invoke {
+ env
+} {
+ Parses the specified SOAP envelope for methods, and invokes these
+ methods with the supplied arguments. The results (if any) are
+ returned to the invoking client as a SOAP response.
+
+ @param env The SOAP envelope to parse for methods to invoke.
+ @return Returns a SOAP response for the invoking client.
+} {
+ # force to v1.1
+ set ver 1.1
+
+ # set encoding style
+ set encoding [soap::server::get_version_encoding $ver]
+
+ # set envelope version
+ set version [soap::server::get_version_namespace $ver]
+
+ # parse incoming soap envelope
+ set doc [dom parse $env]
+
+ # LOG SOAP Request
+ ns_log Notice "\nSOAP Request:\n[$doc asXML]"
+
+ # get doc root
+ set root [$doc documentElement]
+
+ # get child nodes of Envelope
+ set children [$root childNodes]
+
+ # decl method for response
+ set method {}
+ set result {}
+
+ # Brute force envelope search is performed in place of
+ # preferred XPath search. I ran into issues that were complicated
+ # by the fact that XPath was not available on a
+ # baseline installation. The goal is to demonstrate SOAP interop
+ # and not necessarily write the ideal implementation. Furthermore,
+ # if the envelope exists within XML, it
+ # should be found quickly.
+
+ # decl mustUnderstand list
+ set misunderstood {}
+
+ set header [$root selectNodes /SOAP-ENV:Envelope/SOAP-ENV:Header]
+
+ # test for header
+ if ![empty_string_p $header] {
+
+ # get requisites
+ set reqs [$header childNodes]
+
+ # loop
+ foreach r $reqs {
+
+ # look for must understand
+ set mu [$r getAttribute mustUnderstand]
+
+ # test
+ if { $mu == "1" || [string equal -nocase $mu true] } {
+
+ # don't understand anything other than
+ # basics right now
+ # add to list - should be qnames with namespaces??
+ lappend misunderstood [list $r {}]
+ }
+ }
+ }
+
+ set body [$root selectNodes /SOAP-ENV:Envelope/SOAP-ENV:Body]
+
+ # test for body
+ if ![empty_string_p $body] {
+
+ # before proceeding, make sure "misunderstood" var is clear
+ if { $misunderstood != {} } {
+
+ # return misunderstood fault
+ return [soap::fault::generate_misunderstood $misunderstood]
+
+ }
+
+ # get methods
+ set methods [$body childNodes]
+
+ # loop
+ foreach m $methods {
+
+ # get node type
+ set type [$m nodeType]
+
+ # test for element - skip cdata (axis)
+ if { [string equal -nocase $type "cdata_section"] } {
+ # skip
+ continue
+ }
+
+ # get method namespace
+ set service {};
+
+ # verify
+ if { $service == {} } {
+ # parse connection url and see if it's there
+ set service [soap::server::get_url_param service]
+ }
+
+ # get service/namespace id
+ set nid [soap::server::namespace_get_id $service]
+
+ # verify
+ if { $nid < 0 } {
+ # not found
+ return [soap::fault::generate_error "Error: $namespace not found"]
+ }
+
+ # get method
+ set method [$m nodeName]
+
+ # authenticate
+
+ # get method id and proc
+ set id_proc [soap::server::method_get_id_and_proc $nid $method]
+
+ # get id
+ set mid [lindex $id_proc 0]
+
+ # get proc
+ set proc [lindex $id_proc 1]
+
+ # verify
+ if { $mid < 0 } {
+ # throw
+ set error_msg [format "Invalid service method: '%s:%s'" \
+ $service $method]
+ return [soap::fault::generate_error "Error: $error_msg"]
+ }
+
+### Get this working!
+ # try authenticating to method
+#### soap::server::require_permission $mid [soap::server::get_invoke_permission_moniker]
+
+ # build namespace into expr
+ set expr "sg::"
+
+ # append namespace and proc
+ append expr $service :: $proc
+
+ # get args
+ set args [$m childNodes]
+
+ # loop
+ foreach a $args {
+ # get node type
+ set text_node [$a firstChild]
+ lappend expr [$text_node nodeValue]
+ }
+
+ # invoke - error will be caught by
+ # caller and returned as fault
+ set result [eval $expr]
+
+ # done
+ break
+ }
+ }
+
+ return [soap::server::response $version $encoding $method $result]
+}
+
+ad_proc -private soap::server::response {
+ version
+ encoding
+ method
+ result
+} {
+ Constructs a SOAP response based on the specified result and method.
+
+ @param version The version of SOAP.
+ @param encoding The encoding used for the version of SOAP specified.
+ @param method Method name.
+ @param result Result to return to the SOAP client.
+ @return Returns a SOAP response envelope.
+} {
+ # construct xml doc object
+ set doc [dom createDocument env:Envelope]
+
+ # create root node: "env:Envelope"
+ set env [$doc documentElement]
+
+ # define namespace atts into node
+ $env setAttribute xmlns:env $version
+
+ # define encoding style atts into node
+ $env setAttribute env:encodingStyle $encoding
+
+ # create SOAP header - "env:Envelope/env:Header"
+ set header [$env appendChild [$doc createElement env:Header]]
+
+ # create SOAP body - "env:Envelope/env:Body"
+ set body [$env appendChild [$doc createElement env:Body]]
+
+ # create method node - "env:Envelope/env:Body/?method?"
+ set method_node [$body appendChild [$doc createElement [format "m:%s%s" $method Response]]]
+
+ # define namespace atts into node
+ $method_node setAttribute xmlns:m {http://namespace}; # need real namespace
+
+ # create args node - "env:Envelope/env:Body/?method?/?arg?"
+ set result_node [$method_node appendChild [$doc createElement Result]]
+ set args [$result_node appendChild [$doc createTextNode $result]]
+
+ # LOG SOAP Response
+ ns_log Notice "\nSOAP Response:\n[$doc asXML]"
+
+ # render xml into result string
+ return [$doc asXML]
+}
+
+ad_proc -public soap::server::namespace_get_id {
+ service
+} {
+ @param service The service used to query the namespace id for.
+ @return Returns the namespace id for the given service.
+} {
+ return [db_string namespace_id {} -default -1 ]
+}
+
+ad_proc -public soap::server::method_get_id_and_proc {
+ namespace_id
+ method
+} {
+ @param namespace_id
+ @param method
+ @return Returns the method ID and proc name for the given namespace ID.
+} {
+ return [db_string method_id_proc {} -default {-1 {}}]
+}
+
+ad_proc -private soap::server::get_invoke_permission_moniker {
+} {
+ @author William Byrne
+} {
+ # short cut
+ return "invoke"
+
+ # eval global within sg namespace
+ namespace eval sg {
+ # decl moniker
+ variable invoke_moniker
+
+ # test for moniker
+ if { ![info exists invoke_moniker] } {
+ # get it
+ set invoke_moniker [db_string select_moniker {}]
+ }
+
+ # return it
+ return $invoke_moniker
+ }
+}
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/tcl/soap-wsdl-procs-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-wsdl-procs-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-wsdl-procs-postgresql.xql 17 Oct 2004 05:51:54 -0000 1.1
@@ -0,0 +1,48 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="soap::wsdl::method_get_idls.select_idls">
+ <querytext>
+ select idl
+ from sg_methods
+ where namespace_id = :namespace_id
+ order by method_id
+ </querytext>
+ </fullquery>
+
+ <fullquery name="soap::wsdl::method_get_notes.select_notes">
+ <querytext>
+ select notes
+ from sg_methods
+ where method_id = :method_id
+ </querytext>
+ </fullquery>
+
+<fullquery name="soap::wsdl::method_get_id.method_get_id">
+ <querytext>
+ select method_id
+ from sg_methods
+ where namespace_id = :namespace_id and
+ lower(method) = lower(:method)
+ </querytext>
+</fullquery>
+
+<fullquery name="soap::wsdl::method_get_id.method_get_id_with_proc">
+ <querytext>
+ select method_id
+ from sg_methods
+ where namespace_id = :namespace_id and proc = :method
+ </querytext>
+</fullquery>
+
+<fullquery name="soap::wsdl::namespace_get_notes.select_notes">
+ <querytext>
+ select notes
+ from sg_namespaces
+ where namespace_id = :namespace_id
+ </querytext>
+</fullquery>
+
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/tcl/soap-wsdl-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/tcl/soap-wsdl-procs.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/tcl/soap-wsdl-procs.tcl 17 Oct 2004 05:51:54 -0000 1.1
@@ -0,0 +1,639 @@
+ad_library {
+ Tcl API for generating WSDLs.
+
+ Based on William Byrne's soap-gateway implementation.
+
+ @author William Byrne (WilliamB@ByrneLitho.com)
+ @author Nick Carroll (ncarroll@ee.usyd.edu.au)
+ @creation-date 2004-09-24
+ @cvs-id $Id: soap-wsdl-procs.tcl,v 1.1 2004/10/17 05:51:54 ncarroll Exp $
+}
+
+
+namespace eval soap::wsdl {}
+
+
+ad_proc -private soap::wsdl::build_wsdl_url {
+ service
+} {
+ @param service
+} {
+
+ # normal
+ set location [ns_conn location]
+
+ # build wsdl url
+ set wsdl [file join [ad_conn object_url] wsdl]
+
+ # return format
+ return [format "%s%s?service=%s" $location $wsdl $service]
+}
+
+
+ad_proc -private soap::wsdl::method_get_idls {
+ namespace_id
+} {
+ @author William Byrne
+} {
+ # init
+ set methods [list]
+
+ # loop through methods belonging to namespace ??? XQL
+ db_foreach select_idls {} {
+ # append method idl
+ lappend methods $idl
+ }
+
+ # return methods
+ return $methods
+}
+
+
+ad_proc -private soap::wsdl::get_style_parser_expr {
+ {-argpart 0}
+ {style "C"}
+} {
+ @author William Byrne
+} {
+ # switch
+ switch $style {
+ C {
+ # test for arg expression
+ if $argpart {
+
+ #return {(.+)(\w+) *$}
+ return {(\w+\W+)(\w+)}
+
+ } else {
+
+ return {^ *([^ ]+) +([a-zA-Z][a-zA-Z0-9_]*) *\(([^)]*)}
+ }
+ }
+ default {
+ # throw
+ soap::fault::raise "Unsupported IDL parse style: $style"
+ }
+ }
+}
+
+
+ad_proc -public soap::wsdl::method_get_notes {
+ method_id
+} {
+ @author William Byrne
+} {
+ return [db_string select_notes {} -default -1 ]
+}
+
+
+ad_proc -public soap::wsdl::method_get_id {
+ {-proc 0}
+ namespace_id
+ method
+} {
+ @author William Byrne
+} {
+ # test for 'proc' clause
+ if [soap::server::lib::true $proc] {
+ set id [db_string method_get_id_with_proc {} -default -1 ]
+ } else {
+ set id [db_string method_get_id {} -default -1 ]
+ }
+
+ # return
+ return $id
+}
+
+
+ad_proc -private soap::wsdl::build_namespace_uri {
+ service
+} {
+ @author William Byrne
+} {
+ # basic uri
+ return "http://$service.openacs.org/message/"
+}
+
+
+ad_proc -public soap::wsdl::namespace_get_notes {
+ namespace_id
+} {
+ @param namespace_id
+} {
+ return [db_string select_notes {} -default -1 ]
+}
+
+
+ad_proc -private soap::wsdl::map_ctype_to_xtype {
+ type
+} {
+ @param type
+} {
+
+ # strip whitespace
+ regsub -all { } $type {} typ
+
+ # map type
+ switch $typ {
+
+ char -
+ wchar_t {
+ # simple character type
+ return [list xsd:string]
+ }
+
+ int -
+ long {
+ # simpl int
+ return [list xsd:int]
+ }
+
+ float -
+ double {
+ # simple floating point
+ return [list xsd:double]
+ }
+
+ __int64 {
+ # simple long long
+ return [list xsd:long]
+ }
+
+ char[] -
+ wchar_t[] -
+ string -
+ wstring {
+ # string (keep simple)
+ return [list xsd:string]
+ }
+
+ int[] -
+ long[] {
+ # array of ints
+ return [list xsd:int *]
+ }
+
+ float[] -
+ double[] {
+ # array of floating point
+ return [list xsd:double *]
+ }
+
+ __int64[] {
+ # array long long
+ return [list xsd:long *]
+ }
+
+ void {
+ # void type
+ return [list]
+ }
+ }
+
+ # not supported
+ soap::fault::unsupported "unable to map $type to xml type - '$type' refined to '$typ'"
+}
+
+
+ad_proc -private soap::wsdl::build_endpoint {
+ service
+ {trace {}}
+} {
+ @param service
+ @param trace
+} {
+ # test for trace
+ if { $trace != {} } {
+ # use trace info specified in call
+ set location $trace
+ } else {
+ # normal
+ set location [ns_conn location]
+ }
+
+ # build action url
+ set action [file join [ad_conn object_url] action]
+
+ # return format
+ return [format "%s%s?service=%s" $location $action $service]
+}
+
+
+ad_proc -private soap::wsdl::do_generate_wsdl {
+ namespace
+ documentation
+ oneway
+ trace
+} {
+ @author William Byrne
+} {
+
+ # get namespace id
+ set nid [soap::server::namespace_get_id $namespace]
+
+ # verify
+ if { $nid < 0 } {
+
+ # not found
+ soap::fault::raise "service '$namespace' not found" 404
+
+ }
+
+ # fixup documentation boolean
+ set documentation [soap::server::lib::true $documentation]
+
+ # authenticate
+ # ??? soap::server::require_permission $nid read
+
+ # force to v1.1
+ set ver 1.1
+
+ # set encoding style
+ set encoding [soap::server::get_version_encoding $ver]
+
+ # get methods for namespace
+ set funcs [soap::wsdl::method_get_idls $nid]
+
+ # decl methods
+ set methods [list]
+
+ # set up regexp expression for "C" style function
+ set expr [soap::wsdl::get_style_parser_expr C]
+ #set expr {^ *([^ ]+) +([a-zA-Z0-9_]+) *\(([^)]*)}
+
+ # loop through functions
+ foreach func $funcs {
+
+ # invoke regexp
+ regexp $expr $func {} type method argz
+
+ # add func to methods list0
+ lappend methods $method
+
+ # store funcs
+ set method_funcs($method) $argz
+
+ # store func type
+ set method_types($method) $type
+
+ # store args
+ set method_args($method) [split $argz ,]
+
+ # get notes
+ if $documentation {
+ set method_notes($method) [soap::wsdl::method_get_notes \
+ [soap::wsdl::method_get_id $nid $method]]
+ }
+ }
+
+ # construct wsdl doc object
+ set doc [dom createDocument definitions]
+
+ # create root WSDL node: "definitions"
+ set defs [$doc documentElement]
+
+ # build namespace uri for methods
+ set nsuri [soap::wsdl::build_namespace_uri $namespace]
+
+ # define namespace atts into "definitions" node
+ $defs setAttribute name $namespace
+ $defs setAttribute targetNamespace "http://$namespace.openacs.org/wsdl/"
+ $defs setAttribute xmlns:wsdlns "http://$namespace.openacs.org/wsdl/"
+ $defs setAttribute xmlns:typens "http://$namespace.openacs.org/type"
+ $defs setAttribute xmlns:soap "http://schemas.xmlsoap.org/wsdl/soap/"
+ $defs setAttribute xmlns:xsd "http://www.w3.org/2001/XMLSchema"
+ $defs setAttribute xmlns "http://schemas.xmlsoap.org/wsdl/"
+
+ # add documentation
+ if $documentation {
+ # get notes for namespace
+ set notes [soap::wsdl::namespace_get_notes $nid]
+
+ # create child "definitions/documentation" node (allow empty notes)
+ set doc_node [$defs appendChild [$doc createElement documentation]]
+ set docu [$doc_node appendChild [$doc createTextNode $notes]]
+ }
+
+ # create child "definitions/types" node
+ set types [$defs appendChild [$doc createElement types]]
+
+ # create child "definitions/types/schema" node
+ set schema [$types appendChild [$doc createElement schema]]
+
+ # define namespace atts into "definitions/types/schema" node
+ $schema setAttribute targetNamespace "http://$namespace.openacs.org/type"
+ $schema setAttribute xmlns "http://www.w3.org/2001/XMLSchema"
+ $schema setAttribute xmlns:enc $encoding
+ $schema setAttribute xmlns:wsdl "http://schemas.xmlsoap.org/wsdl/"
+ $schema setAttribute elementFormDefault "qualified"
+
+ # loop through decomposed methods
+ foreach m $methods {
+
+ # get args
+ set argz $method_args($m)
+
+ # create "definitions/message" node
+ set message [$defs appendChild [$doc createElement message]]
+
+ # add name attr
+ $message setAttribute name "$namespace.$m"
+
+ # add documentation
+ if $documentation {
+
+ # create child "definitions/message/documentation" node
+ # (allow empty notes)
+ set doc_node [$message appendChild [$doc createElement documentation]]
+ set docu [$doc_node appendChild [$doc createTextNode $method_notes($m)]]
+ }
+
+ # decl param order arg
+ set order ""
+
+ # get arg part parser expr
+ set expr [soap::wsdl::get_style_parser_expr -argpart 1 C]
+
+ # loop through args
+ foreach a $argz {
+
+ # split arg type from its name
+ if ![regexp $expr $a {} typ nam] {
+
+ # format problem
+ error "unexpected argument format: '$a' in '$argz', '$m', '$method_args($m)'"
+
+ }
+
+ # add arg to param order var
+ lappend order $nam
+
+ # map type
+ set xtype [soap::wsdl::map_ctype_to_xtype $typ]
+
+ # get component count
+ set cnt [llength $xtype]
+
+ # test for simple
+ if { $cnt == 1 } {
+
+ # create arg parts
+ set part [$message appendChild [$doc createElement part]]
+
+ # add name attr
+ $part setAttribute name $nam
+
+ # add type attr
+ $part setAttribute type [lindex $xtype 0]
+
+ } else {
+
+ # not yet supported
+ soap::fault::unsupported "cannot spec non simple types: $a, $xtype"
+ }
+ }
+
+ # reset method_args to hold param order
+ set method_args($m) $order
+
+ # build return message
+ set typ $method_types($m)
+
+ # map type
+ set xtype [soap::wsdl::map_ctype_to_xtype $typ]
+
+ # get component count
+ set cnt [llength $xtype]
+
+ # test for void
+ if { $cnt != 0} {
+
+ # set boolean into method type for Respond in portType wsdl node
+ set method_types($m) 1
+
+ # create response message
+ set message [$defs appendChild [$doc createElement message]]
+
+ # add name attr
+ $message setAttribute name [format "$namespace.$m%s" Response]
+
+ # test for simple
+ if { $cnt == 1 } {
+
+ # create arg parts
+ set part [$message appendChild [$doc createElement part]]
+
+ # add name attr
+ $part setAttribute name Result
+
+ # add type attr
+ $part setAttribute type [lindex $xtype 0]
+
+ } else {
+ # not yet supported
+ soap::fault::unsupported "cannot spec non simple types: $typ"
+ }
+
+ } elseif { $oneway } {
+ # set false boolean into method type eliminating
+ # Respond in portType wsdl node
+ set method_types($m) 0
+ } else {
+ # set true boolean into method type forcing
+ # void Respond in portType wsdl node
+ set method_types($m) 1
+
+ # create response message
+ set message [$defs appendChild [$doc createElement message]]
+
+ # add name attr
+ $message setAttribute name [format "$namespace.$m%s" Response]
+
+ # force string result type
+ if { 1 } {
+
+ # create arg parts
+ set part [$message appendChild [$doc createElement part]]
+
+ # add name attr
+ $part setAttribute name Result
+
+ # add type attr
+ $part setAttribute type {xsd:string}
+ }
+ }
+ }
+
+ # create portType "definitions/portType" node
+ set portType [$defs appendChild [$doc createElement portType]]
+
+ # set its name
+ $portType setAttribute name [format "%s%s" $namespace SoapPort]
+
+ # create operations for each function
+ foreach m $methods {
+
+ # create new operation
+ set operation [$portType appendChild [$doc createElement operation]]
+
+ # set its name
+ $operation setAttribute name $m
+
+ # set parameter order
+ $operation setAttribute parameterOrder $method_args($m)
+
+ # create input op
+ set input [$operation appendChild [$doc createElement input]]
+
+ # bind to message node
+ $input setAttribute message [format "wsdlns:%s.%s" $namespace $m]
+
+ # test for non void function (false if void)
+ if $method_types($m) {
+
+ # create output op
+ set output [$operation appendChild [$doc createElement output]]
+
+ # bind to message node
+ $output setAttribute message [format "wsdlns:%s.%s%s" $namespace $m Response]
+ }
+ }
+
+ # setup RPC bindings, encodings, and namespaces
+
+ # create binding node - "definitions/binding"
+ set binding [$defs appendChild [$doc createElement binding]]
+
+ # set its name
+ $binding setAttribute name [format "%s%s" $namespace SoapBinding]
+
+ # set its type
+ $binding setAttribute type [format "wsdlns:%s%s" $namespace SoapPort]
+
+ # create child soap binding node
+ set soap_binding [$binding appendChild [$doc createElement soap:binding]]
+
+ # set rpc style
+ $soap_binding setAttribute style rpc
+
+ # set transport
+ $soap_binding setAttribute transport {http://schemas.xmlsoap.org/soap/http}
+
+ # loop through methods
+ foreach m $methods {
+
+ # create input child - "definitions/binding/operation"
+ set operation [$binding appendChild [$doc createElement operation]]
+
+ # set its name
+ $operation setAttribute name $m
+
+ # create child soap operation node
+ # definitions/binding/operation/soap:operation
+ set soap_operation [$operation appendChild [$doc createElement soap:operation]]
+
+ # set soap action
+ $soap_operation setAttribute soapAction [format "http://%s.openacs.org/action/%s.%s" $namespace $namespace $m]
+
+ # create child input - "definitions/binding/operation/input"
+ set input [$operation appendChild [$doc createElement input]]
+
+ # create child soap_body node
+ # definitions/binding/operation/input/soap:body
+ set soap_body [$input appendChild [$doc createElement soap:body]]
+
+ # set 'use' attr
+ $soap_body setAttribute use encoded
+
+ # set namespace
+ $soap_body setAttribute namespace $nsuri
+
+ # set encoding
+ $soap_body setAttribute encodingStyle $encoding
+
+ # test for output
+ if $method_types($m) {
+
+ # create child output - "definitions/binding/operation/output"
+ set output [$operation appendChild [$doc createElement output]]
+
+ # create child soap_body node
+ # definitions/binding/operation/output/soap:body
+ set soap_body [$output appendChild [$doc createElement soap:body]]
+
+ # set 'use' attr
+ $soap_body setAttribute use encoded
+
+ # set namespace
+ $soap_body setAttribute namespace "http://$namespace.openacs.org/message/"
+
+ # set encoding
+ $soap_body setAttribute encodingStyle $encoding
+ }
+ }
+
+ # create service
+
+ # create service node - "definitions/service"
+ set service [$defs appendChild [$doc createElement service]]
+
+ # set its name
+ $service setAttribute name $namespace
+
+ # create child port - "definitions/service/port"
+ set port [$service appendChild [$doc createElement port]]
+
+ # set its name
+ $port setAttribute name [format "%s%s" $namespace SoapPort]
+
+ # set its binding
+ $port setAttribute binding [format "wsdlns:%s%s" $namespace SoapBinding]
+
+ # create child address - "definitions/service/port/soap:address"
+ set soap_address [$port appendChild [$doc createElement soap:address]]
+
+ # set its location
+ $soap_address setAttribute location [soap::wsdl::build_endpoint $namespace $trace]
+
+ # render xml into string
+ return [$doc asXML]
+
+}
+
+
+ad_proc -public soap::wsdl::generate_wsdl {
+ {-documentation 1}
+ namespace
+ {oneway 1}
+ {trace {}}
+} {
+ @author William Byrne
+} {
+ # fixup and set missing to true
+ if { $oneway == {} } { set oneway 1 }
+
+ # try
+ if { [catch {
+
+ # delegate to do_generate
+ set wsdl [soap::wsdl::do_generate_wsdl $namespace $documentation $oneway $trace]
+
+ } msg] } {
+
+ # get error code
+ global errorCode
+ set code $errorCode
+
+ # normalize error code
+ if { ![string is integer $code] } { set code 500 }
+
+ # error
+ global errorInfo
+ ns_returnerror $code "<pre>$msg\n$errorInfo</pre>"
+
+ } else {
+
+ # return wsdl
+ return $wsdl
+ }
+}
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/action.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/action.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/action.tcl 17 Oct 2004 05:51:55 -0000 1.1
@@ -0,0 +1,78 @@
+# /packages/soap-gateway/www/action.tcl
+
+# page contract not included due to cost of parsing payload - (not necessary)
+
+# generate temp file name
+set tmp [ns_tmpnam]
+
+# open it
+set f [open $tmp w+]
+
+# perform file ops in safe block to ensure tmp file unlink
+# (yes, this is a back asswards approach)
+set err [catch {
+
+ # dump payload to file - there's gotta be a better way to get the content
+ ns_conncptofp $f
+
+ # get file size
+ set size [tell $f]
+
+ # limit incoming envelope size to 1/4 meg
+ if { $size > 262144 || $size < 0 } {
+
+ # throw it
+ error "payload too large"
+
+ }
+
+ # seek to beginning
+ seek $f 0
+
+ # read file contents into SOAP envelope var
+ set env [read $f $size]
+
+} msg]
+
+# test for error
+if { $err != 0 } {
+
+ # make em' wait
+ ns_sleep 5
+
+ # prep
+ set savedInfo {}
+
+ # advise
+ global errorInfo
+
+ # test
+ if { [info exists errorInfo] != 0 } {
+
+ # preserve error info
+ set savedInfo $errorInfo
+
+ }
+
+ # release file
+ catch { close $f }
+
+ # unlink file
+ ns_unlink $tmp
+
+ # throw
+ error "$msg\nfile: $tmp" $savedInfo
+
+} else {
+
+ # release file
+ catch { close $f }
+
+ # unlink file
+ ns_unlink $tmp
+
+
+}
+
+# invoke envelope using lib functions and return
+ns_return 200 text/xml [soap::server::invoke $env]
Index: openacs-4/packages/soap-gateway/www/debug.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/debug.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/debug.adp 17 Oct 2004 05:51:55 -0000 1.1
@@ -0,0 +1,4 @@
+<master src="./master">
+<include src="toolbar">
+<formtemplate id="debug_form"></formtemplate>
+@result@
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/debug.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/debug.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/debug.tcl 17 Oct 2004 05:51:55 -0000 1.1
@@ -0,0 +1,37 @@
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: debug.tcl,v 1.1 2004/10/17 05:51:55 ncarroll Exp $
+} {
+ {expr {}}
+}
+
+template::form create debug_form
+
+# build service input field
+template::element create debug_form expr \
+ -widget textarea \
+ -datatype text \
+ -label "expr" \
+ -html { rows 8 cols 80 wrap off } \
+ -value $expr
+
+# test for valid form
+if [template::form is_valid debug_form] {
+
+ if [catch {
+ set result [uplevel $expr]
+ } msg] {
+ set result $msg
+ }
+
+} else {
+
+ set result {}
+
+}
+
+ad_return_template
+
+
Index: openacs-4/packages/soap-gateway/www/index-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/index-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/index-postgresql.xql 17 Oct 2004 05:51:55 -0000 1.1
@@ -0,0 +1,11 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="namespace_list">
+ <querytext>
+ select namespace_id, service, uri, notes from sg_namespaces
+ </querytext>
+ </fullquery>
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/index.adp 17 Oct 2004 05:51:55 -0000 1.1
@@ -0,0 +1,98 @@
+<master src="./master">
+<include src="toolbar" caption="@caption@">
+<!-- link href="basic.css" rel="stylesheet" type="text/css" -->
+
+<if @namespaces:rowcount@ gt 0>
+<a name="top"></a>
+<table width="800" border=1 cellpadding=2 cellspacing=2>
+ <tr>
+ <td width="118" bgcolor=#cccccc><strong>Service</strong></td>
+ <td width="488" bgcolor=#cccccc><strong>Notes</strong></td>
+ <td width="54" bgcolor=#cccccc><strong>WSDL</strong></td>
+ </tr>
+ <multiple name="namespaces" rowcount=1>
+ <tr>
+ <td>
+ <a href="#@namespaces.service@">@namespaces.service@</a>
+ </td>
+ <td>
+ @namespaces.notes;noquote@
+ </td>
+ <td><a href="@namespaces.wsdl@">wsdl</a></td>
+ </tr>
+ </multiple>
+</table>
+
+</if><else>
+<p><em>There are no namespaces</em></p>
+</else>
+<if @namespaces:rowcount@ gt 0>
+<multiple name="namespaces">
+<hr size="1" width="800" align="left">
+<table width="800" border="0">
+ <tr>
+ <td width="129"><b><a name="@namespaces.service@"></a>Service:</b></td>
+ <td width="636"><b>
+ @namespaces.service@
+ </b> </td>
+ <td width="21"><a href="#"><img src="top.gif" width="12" height="12" border="0"></a></td>
+ </tr>
+ <tr>
+ <td><b>Endpoint:</td>
+ <td></b><a href="@namespaces.endpoint@">
+ @namespaces.endpoint@
+ </a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td><b>WSDL:</td>
+ <td></b><a href="@namespaces.wsdl@">
+ @namespaces.wsdl@
+ </a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td> <em>force response:</em></td>
+ <td><a href="@namespaces.wsdl@&oneway=0">
+ @namespaces.wsdl@
+ &oneway=0</a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td> <em>no documentation:</em></td>
+ <td><a href="@namespaces.wsdl@&documentation=0">
+ @namespaces.wsdl@
+ &documentation=0</a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td> <em>trace:</em></td>
+ <td><a href="@namespaces.wsdl@&trace=http://localhost:8080">
+ @namespaces.wsdl@
+ &trace=http://localhost:8080</a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td><b>URI</b></td>
+ <td>
+ @namespaces.uri@
+ </td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td><b>SOAPAction</b></td>
+ <td>N/A</td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td valign="top"><b>Notes:</td>
+ <td></b>
+ @namespaces.notes;noquote@ <a href="doc/service?service=@namespaces.service@">(more)</a>
+ </td>
+ <td> </td>
+ </tr>
+</table>
+</multiple>
+</if>
+
+
Index: openacs-4/packages/soap-gateway/www/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/index.tcl 17 Oct 2004 05:51:56 -0000 1.1
@@ -0,0 +1,61 @@
+# packages/soap-gateway/www/index.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: index.tcl,v 1.1 2004/10/17 05:51:56 ncarroll Exp $
+} {
+}
+
+# clear title
+set title {}
+
+# installed correctly
+if [catch {
+
+ soap::server::lib::true 1
+
+}] {
+
+ # report as installation error
+ error "Failure while calling soap-gateway function!\nDid you restart the server after installing soap-gateway package?\n\n"
+
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id read
+
+# query namespaces
+db_multirow -extend {endpoint edit delete wsdl} namespaces namespace_list {} {
+ set endpoint [soap::wsdl::build_endpoint $service]
+ set edit "edit-namespace?namespace_id=$namespace_id"
+ set delete "delete-namespace?namespace_id=$namespace_id"
+ set wsdl [soap::wsdl::build_wsdl_url $service]
+}
+
+# create form
+template::form create new_namespace_form
+
+# change action attribute for form - not documented
+set new_namespace_form:properties(action) edit-namespace
+
+# create form
+template::form create init_workspace_form
+
+# change action attribute for form - not documented
+set init_workspace_form:properties(action) init-workspace
+
+# create form
+template::form create init_interop_form
+
+# change action attribute for form - not documented
+set init_interop_form:properties(action) init-interop
+
+# update caption
+set caption "services"
+
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/master.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/master.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/master.adp 17 Oct 2004 05:51:56 -0000 1.1
@@ -0,0 +1,91 @@
+<master>
+<property name="title">@title@</property>
+<if @context@ not nil>
+ <property name="context">@context@</property>
+</if>
+<property name="context_bar">@context_bar@</property>
+<property name="header_stuff">
+@header_stuff@
+<style>
+.sg_toolbar {
+ font-family: tahoma,verdana,arial,helvetica;
+ font-size: 70%;
+ font-weight: bold; color: #ccccff;
+ text-decoration: none;
+}
+
+.sg_toolbar:hover {
+ color: white;
+ text-decoration: underline;
+}
+
+A.sg_toolbar {
+ color: white;
+}
+
+INPUT.toolbar {
+ font-family: tahoma,verdana,arial,helvetica;
+ font-weight: bold;
+ font-size: 70%; color: black;
+}
+
+.summary {
+ font-size: 70%;
+ font-family: verdana,arial,helvetica;
+}
+
+.summary_bold {
+ font-size: 70%;
+ font-family: verdana,arial,helvetica;
+ font-weight: bold;
+}
+
+pre {
+ font-family: Courier;
+ font-size: 10pt;
+}
+
+
+
+.section {
+ font: bold medium Arial;
+}
+
+.text {
+ font-family: "Times New Roman", Times, serif;
+}
+
+.toc {
+ list-style-type : inherit;
+ list-style : decimal-leading-zero;
+}
+
+.tcl-files {
+ list-style-image: url(tcl.gif);
+}
+
+.adp-file {
+ list-style-image: url(www.gif);
+}
+
+.html-file {
+ list-style-image: url(www.gif);
+}
+
+.text-files {
+ list-style-image: url(text.gif);
+}
+
+.folder-files {
+ list-style-image: url(folder.gif);
+}
+
+.file-desc {
+ width : 320;
+}
+
+</style>
+</property>
+<slave>
+
+
Index: openacs-4/packages/soap-gateway/www/master.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/master.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/master.tcl 17 Oct 2004 05:51:56 -0000 1.1
@@ -0,0 +1,18 @@
+# Expects "title" and "header" and "context_bar"
+
+if { ![info exists context_bar] } {
+ set context_bar {}
+}
+
+if ![info exists header_stuff] {
+ set header_stuff {}
+}
+
+if ![info exists title] {
+
+ # clear
+ set title {}
+
+}
+
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/toolbar.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/toolbar.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/toolbar.adp 17 Oct 2004 05:51:56 -0000 1.1
@@ -0,0 +1,22 @@
+<table width="100%" bgcolor="#000000" border="0">
+<tr><td>
+<table border="0">
+<tr><td>
+<a href="@base@" class="sg_toolbar" style="color: yellow">soap-gateway</a>
+<if @caption@ not nil><span class="sg_toolbar" style="color: yellow"> —
+</span><a href="." class="sg_toolbar" style="color: yellow">@caption@</a></if>
+</td></tr>
+</table>
+</td><td align="right">
+<table border="0">
+ <tr> <multiple name="toolbar">
+ <td><span class="sg_toolbar"> | </span><a href="@toolbar.url@" class="sg_toolbar">
+ @toolbar.symbol@
+ </a></td>
+ </multiple> </tr>
+</table>
+</td></tr>
+</table>
+<p>
+
+
Index: openacs-4/packages/soap-gateway/www/toolbar.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/toolbar.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/toolbar.tcl 17 Oct 2004 05:51:56 -0000 1.1
@@ -0,0 +1,85 @@
+# /packages/soap-gateway/www/toolbar.tcl
+
+# layout inspired by bug-tracker
+
+# safety
+if ![info exists caption] {
+
+ # clear
+ set caption {}
+}
+
+# clear for tools
+set tools []
+
+# add standard tools
+set defaults [list help services tests]
+
+# package id
+set pid [soap::package_id -throw f]
+
+# verify
+if { $pid == 0 } {
+
+ # must be just starting out - clear everything
+ set defaults [list]
+
+# test for admin user
+} elseif { [soap::server::has_permission $pid admin] != 0 } {
+
+ # add em'
+ lappend defaults admin permissions
+
+}
+
+# update tools list
+foreach default $defaults {
+
+ # test current list and skip if caption
+ # ??? if $default equal to caption, then assume $default tool page is current
+ if { [lsearch $tools $default] < 0 && ![string equal -nocase $default $caption] } {
+
+ # add
+ lappend tools $default
+ }
+}
+
+# get href base
+set base [soap::get_base_url]
+
+# create multirow
+multirow create toolbar symbol url
+
+# loop through list
+foreach tool $tools {
+
+ # switch
+ case $tool {
+ help {
+ # add
+ multirow append toolbar help [file join $base doc]
+ }
+ services {
+ # add
+ multirow append toolbar services [file join $base ]
+ }
+ admin {
+ # add
+ multirow append toolbar admin [file join $base admin ]
+ }
+ tests {
+ # add
+ multirow append toolbar tests [file join $base tests ]
+ }
+ permissions {
+ # set href
+ set url "/permissions/one?object_id=$pid"
+
+ # add
+ multirow append toolbar permissions $url
+
+ }
+ }
+}
+
+ad_template_return
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/top.gif
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/top.gif,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/wsdl.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/wsdl.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/wsdl.tcl 17 Oct 2004 05:51:56 -0000 1.1
@@ -0,0 +1,19 @@
+# packages/soap-gateway/www/wsdl.tcl
+
+# clear title
+set title {}
+
+# get params from url
+set params [soap::server::get_url_params]
+
+# get interested params
+set service [ns_set get $params service]
+set oneway [ns_set get $params oneway]
+set trace [ns_set get $params trace]
+set docs [ns_set get $params documentation]
+if ![string length $docs] { set docs 1 }
+
+# render xml and return
+ns_return 200 text/xml [soap::wsdl::generate_wsdl -documentation $docs $service $oneway $trace]
+
+
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/admin/delete-method-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/delete-method-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/delete-method-postgresql.xql 17 Oct 2004 05:51:56 -0000 1.1
@@ -0,0 +1,13 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="select_method">
+ <querytext>
+ select method, idl, idl_style, notes
+ from sg_methods
+ where method_id = :method_id
+ </querytext>
+ </fullquery>
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/admin/delete-method.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/delete-method.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/delete-method.adp 17 Oct 2004 05:51:56 -0000 1.1
@@ -0,0 +1,6 @@
+<master src="../master">
+<!-- link href="basic.css" rel="stylesheet" type="text/css" -->
+<!-- property name="context">@context@</property -->
+<include src="../toolbar">
+Delete the following method: <b>@method@</b>
+<formtemplate id="method_form" style="plain"></formtemplate>
Index: openacs-4/packages/soap-gateway/www/admin/delete-method.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/delete-method.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/delete-method.tcl 17 Oct 2004 05:51:56 -0000 1.1
@@ -0,0 +1,55 @@
+# packages/soap-gateway/www/admin/method-namespace.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: delete-method.tcl,v 1.1 2004/10/17 05:51:56 ncarroll Exp $
+} {
+ namespace_id:integer,notnull
+ method_id:integer,notnull
+}
+
+# clear title
+set title {}
+
+# get package
+set package_id [ad_conn package_id]
+
+# verify namespace id
+soap::method_check $method_id
+
+# require write permission
+ad_require_permission $method_id admin; #write
+
+# set session context
+set context [list "Administration"]
+
+# create form
+template::form create method_form
+
+# store namespace_id into hidden form element
+template::element create method_form namespace_id \
+ -widget hidden \
+ -datatype text \
+ -value $namespace_id
+
+# store method_id into hidden form element
+template::element create method_form method_id \
+ -widget hidden \
+ -datatype text \
+ -value $method_id
+
+# query for method attributes
+db_1row select_method {}
+
+# test for valid form
+if [template::form is_valid method_form] {
+
+ # update existing
+ soap::method_delete $method_id
+
+ ad_returnredirect "./edit-namespace?namespace_id=$namespace_id"
+}
+
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/admin/delete-namespace-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/delete-namespace-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/delete-namespace-postgresql.xql 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,13 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="namespace_select">
+ <querytext>
+ select service, uri, notes
+ from sg_namespaces
+ where namespace_id = :namespace_id
+ </querytext>
+ </fullquery>
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/admin/delete-namespace.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/delete-namespace.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/delete-namespace.adp 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,5 @@
+<master src="../master">
+<!-- property name="context">@context@</property -->
+<include src="../toolbar">
+Delete the following service: <b>@service@</b>
+<formtemplate id="namespace_form" style="plain"></formtemplate>
Index: openacs-4/packages/soap-gateway/www/admin/delete-namespace.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/delete-namespace.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/delete-namespace.tcl 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,48 @@
+# packages/soap-gateway/www/admin/delete-namespace.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: delete-namespace.tcl,v 1.1 2004/10/17 05:51:57 ncarroll Exp $
+} {
+ namespace_id:integer,notnull
+}
+
+# clear title
+set title {}
+
+# get package
+set package_id [ad_conn package_id]
+
+# verify namespace id
+soap::namespace_check $namespace_id
+
+# require admin permission
+ad_require_permission $namespace_id admin; #write
+
+# set session context to delete mode
+set context [list "Administration"]
+
+# create form
+template::form create namespace_form
+
+# store namespace_id into hidden form element
+template::element create namespace_form namespace_id \
+ -widget hidden \
+ -datatype text \
+ -value $namespace_id
+
+# query for namespace attributes
+db_1row namespace_select {}
+
+# test for valid form
+if [template::form is_valid namespace_form] {
+
+ # update existing
+ soap::namespace_delete $namespace_id
+
+ ad_returnredirect "./"
+}
+
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/admin/edit-namespace-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/edit-namespace-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/edit-namespace-postgresql.xql 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,29 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="namespace_select">
+ <querytext>
+ select service, uri, notes
+ from sg_namespaces
+ where namespace_id = :namespace_id
+ </querytext>
+ </fullquery>
+
+ <fullquery name="namespace_select_all">
+ <querytext>
+ select method_id, namespace_id, method, idl, idl_style, proc, notes
+ from sg_methods
+ where namespace_id = :namespace_id
+ </querytext>
+ </fullquery>
+
+ <fullquery name="method_select">
+ <querytext>
+ select method, idl, idl_style, proc, notes
+ from sg_methods
+ where method_id = :method_id
+ </querytext>
+ </fullquery>
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/admin/edit-namespace.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/edit-namespace.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/edit-namespace.adp 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,143 @@
+<master src="../master">
+<!-- property name="context">@context@</property -->
+<property name="focus">@focus@</property>
+<include src="../toolbar" caption="@caption@">
+<formtemplate id="namespace_form" style="plain"></formtemplate>
+<hr size="1" width="800" align="left">
+<if @editing_namespace@ not eq 0>
+<h3>Methods</h3>
+<formtemplate id="method_form">
+<table width="980" border=1 cellpadding=2 cellspacing=2>
+ <tr>
+ <td width="120" bgcolor=#cccccc><strong>proc</strong></td>
+ <td width="240" bgcolor=#cccccc><strong>IDL</strong></td>
+ <td width="400" bgcolor=#cccccc><strong>Notes</strong></td>
+ <td width="68" bgcolor=#cccccc> </td>
+ <td width="55" bgcolor=#cccccc> </td>
+ </tr>
+ <multiple name="methods">
+ <if @editing_method@ eq @methods.method_id@>
+ <tr>
+ <td valign="top"><formwidget id="proc"></td>
+ <td valign="top">
+ <formwidget id="idl">
+ @idl_help@
+ </td>
+ <td>
+ <formwidget id="method_notes">
+ </td>
+ <td><input type="submit" value="update"><!-- a href="javascript:document.method_form.submit();">update</a --></td>
+ <td><a href="@methods.cancel@">cancel</a></td>
+ </tr>
+ </if><else>
+ <if @methods.method_id@ lt 0>
+ <tr>
+ <td>
+ <font color="#FF0000">
+ @methods.proc@
+ </font>
+ </td>
+ <td>
+ <font color="#FF0000">
+ <a href="#@methods.diff@">@methods.idl@</a>
+ </font>
+ </td>
+ <td>
+ @methods.notes@
+ </td>
+ <td><a href="@methods.edit@">import</a></td>
+ <td> </td>
+ </tr>
+ </if><else>
+ <tr>
+ <td>
+ <if @methods.diff@ not eq "SAME">
+ <font color="#FF0000">
+ <a href="#@methods.diff@">@methods.proc@</a>
+ </font>
+ </if><else>
+ <font color="#000000">
+ @methods.proc;noquote@
+ </font>
+ </else>
+ </td>
+ <td>
+ <if @methods.diff@ not eq "SAME">
+ <font color="#FF0000">
+ </if><else>
+ <font color="#000000">
+ </else>
+ @methods.idl;noquote@
+ </font>
+ </td>
+ <td>
+ @methods.notes;noquote@
+ </td>
+ <td><a href="@methods.edit@">edit</a></td>
+ <td><a href="@methods.delete@">delete</a></td>
+ </tr>
+ </else>
+ </else>
+ </multiple>
+ <if @editing_method@ eq 0>
+ <tr>
+ <td valign="top"><formwidget id="proc"></td>
+ <td valign="top">
+ <formwidget id="idl">@idl_help;noquote@
+ </td>
+ <td>
+ <formwidget id="method_notes">
+ </td>
+ <td><input type="submit" value="create" ><!-- a href="javascript:document.method_form.submit();">create</a --></td>
+ <td> </td>
+ </tr>
+ </if>
+</table>
+</formtemplate></if>
+<p><if @editing_namespace@ not eq 0>
+<h3>Error Descriptions</h3>
+<table width="840" border="0">
+ <tr>
+ <td width="120" valign="top"><a name="UPUB"><strong>Not Published</strong></a></td>
+ <td>A public Tcl proc within the <em><strong>
+ @namespace@
+ </strong></em> namespace exists that is not published . Selecting <em>import </em>will
+ add the procedure to the WSDL database. The proc will then be available
+ for public access using the name specified within <strong>ad_proc's </strong>
+ <em>@idl</em>
+ parameter. If the <em>@idl</em> parameter is missing, the proc's symbolic name will be used instead.<br>
+ </td>
+ </tr>
+ <tr>
+ <td valign="top"><a name="DUPL" id="DUPL"></a><strong>Duplicate IDL</strong></td>
+ <td>The soap-gateway's <em>diff</em> algorithm detected a potential duplicate
+ method name. The calculated IDL name already exists within the WSDL
+ database for the <em><strong>@namespace@</strong></em> namespace. Or, the IDL name for the Tcl proc was
+ detected within the list of sibling procs not yet published to the WSDL database.
+ In either case, the Tcl proc cannot be published
+ until it's IDL name is made unique within the <em><strong>
+ @namespace@
+ </strong></em> namespace.<br>
+ </td>
+ </tr>
+ <tr>
+ <td valign="top"><a name="ORPH"><strong>Orphan</strong></a></td>
+ <td>A published method exists within the WSDL database that has no corresponding
+ <em>public</em> Tcl proc in the <em><strong>
+ @namespace@
+ </strong></em> namespace. Either delete the entry or supply a <em>public</em> Tcl proc.
+ <br>
+ </td>
+ </tr>
+ <tr>
+ <td valign="top"><a name="ARGS"><strong>Arguments</strong></a></td>
+ <td>A discrepency exists between the arguments of the Tcl proc and the published method in the
+ WSDL database. Comparisons are made to the argument names only. No type checking is performed.
+ <br>
+ </td>
+ </tr>
+</table>
+</if><else>
+<p><em>There are no methods!</em></p>
+</else>
+@diffdata@
Index: openacs-4/packages/soap-gateway/www/admin/edit-namespace.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/edit-namespace.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/edit-namespace.tcl 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,492 @@
+# packages/soap-gateway/www/admin/edit-namespace.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: edit-namespace.tcl,v 1.1 2004/10/17 05:51:57 ncarroll Exp $
+} {
+ namespace_id:integer,notnull,optional
+ {service ""}
+ {notes:html ""}
+ method_id:integer,notnull,optional
+ {idl ""}
+ {proc ""}
+ {method_notes:html ""}
+ {import 0}
+} -properties {
+ focus
+}
+
+# test for import
+if [soap::server::lib::true $import] {
+
+ # test for single method import
+ if { $proc != {} } {
+
+ # perform single import
+ set nid [soap::server::lib::import_service \
+ -proc $proc $service]
+
+ } else {
+
+ # perform full import
+ set nid [soap::server::lib::import_service $service]
+
+ # return to admin page
+ ad_returnredirect .
+
+ }
+
+ # verify args
+ if { [info exists namespace_id] != 0 && $nid != $namespace_id } {
+
+ # egats
+ soap::fault::raise "Namespace id mismatch during import"
+
+ } else {
+
+ # set id
+ set namespace_id $nid
+
+ }
+
+}
+
+# clear error
+set error {}
+
+# clear focus
+set focus {}
+
+# init debug var
+set diffdata {}
+
+# get idl help
+set idl_help [soap::get_idl_help]
+
+# get package
+set package_id [ad_conn package_id]
+
+# check to see if namespace_id is assigned
+if {[info exists namespace_id]} {
+
+ # verify namespace id
+ soap::namespace_check $namespace_id
+
+ # require write permission
+ ad_require_permission $namespace_id admin; #write
+
+ # set session context to edit mode
+ set context [list "Edit Namespace"]
+
+} else {
+
+ # require write permission for new namespace
+ ad_require_permission $package_id admin; #create
+
+ # set session context to creation mode
+ set context [list "New Namespace"]
+
+}
+
+# create form
+template::form create namespace_form
+
+# test for namespace_id assigment
+if {[info exists namespace_id]} {
+
+ # set editing
+ set editing_namespace 1
+
+} else {
+
+ # creating
+ set editing_namespace 0
+
+}
+
+# build service input field
+template::element create namespace_form service \
+ -datatype text \
+ -label "Service" \
+ -html { size 32 } \
+ -value {}; #$service
+
+# build notes input field
+template::element create namespace_form notes \
+ -widget textarea \
+ -datatype text \
+ -label "Notes" \
+ -html { rows 8 cols 80 wrap off } \
+ -value {}; #$notes
+
+# test for valid form
+if [template::form is_valid namespace_form] {
+
+ # clear method_id to disable method logic below
+ if [info exists method_id] { unset method_id }
+
+ # clean up service
+ set service [string trim $service]
+
+ # try
+ set err [catch {
+
+ # verify
+ soap::check_symbol $service
+
+ } error]
+
+ # verify
+ if { $err } {
+
+ # do nothing
+
+ } else {
+
+ # get session values
+ set user_id [ad_conn user_id]
+ set peeraddr [ad_conn peeraddr]
+
+ # force uri to xxxx.openacs.org
+ set uri "http://$service.openacs.org/methods"
+
+ # look for id of named method
+ set nid [soap::server::namespace_get_id $service]
+
+ # verify
+ if { $nid > 0 && (![info exists namespace_id] || $nid != $namespace_id) } {
+
+ # egats
+ soap::fault::raise "Duplicate service: $service"
+ }
+
+ # test for assigned namespace id
+ if [info exists namespace_id] {
+
+ # update existing
+ soap::server::lib::namespace_update $namespace_id \
+ $service $uri $notes
+
+ } else {
+
+ # create new
+ soap::server::lib::namespace_new $service $uri $notes $user_id $peeraddr $package_id
+
+ # return to admin page
+ ad_returnredirect .
+
+ }
+
+ # ok return to main list
+ #ad_returnredirect "./"
+
+ }
+
+}
+
+# test for editing
+if { $editing_namespace != 0 } {
+
+ # store namespace_id into hidden form element
+ template::element create namespace_form namespace_id \
+ -widget hidden \
+ -datatype text \
+ -value $namespace_id
+
+ # query for namespace attributes
+ db_1row namespace_select {}
+
+ # update form elements
+ template::element set_value namespace_form service $service
+ template::element set_value namespace_form notes $notes
+
+ # create method form
+ template::form create method_form
+
+ set method_form:properties(action) edit-namespace
+
+ # test for method_id assigment
+ if [info exists method_id] {
+
+ # set editing
+ set editing_method $method_id
+
+ } else {
+
+ # creating
+ set editing_method 0
+
+ }
+
+ # store namespace_id into hidden form element
+ template::element create method_form namespace_id \
+ -widget hidden \
+ -datatype text \
+ -value $namespace_id
+
+ # build idl input field
+ template::element create method_form idl \
+ -datatype text \
+ -label "IDL" \
+ -html { size 48 } \
+ -value {}; #$idl
+
+ # decl procs
+ set procs2 [list]
+
+ # get source procs and double entries for HTML options
+ foreach p [soap::get_source_procs $service] {
+
+ # get local
+ set local [namespace tail $p]
+
+ # append
+ lappend procs2 [list "$local {[info args $p]}" $local]
+
+ }
+
+ # build proc select
+ template::element create method_form proc \
+ -datatype text \
+ -label "Procedure" \
+ -widget select \
+ -options $procs2 \
+ -value $proc
+
+ # build notes input field
+ template::element create method_form method_notes \
+ -widget textarea \
+ -datatype text \
+ -label "Notes" \
+ -html { rows 10 cols 40 wrap off } \
+ -value {}; #$notes
+
+ # test for valid form
+ if { [template::form is_valid method_form] } {
+
+ # try
+ set err [catch {
+
+ # decompose IDL
+ set xsd [soap::server::lib::idl_to_xsd "C" $idl]
+
+ # get method
+ set method [lindex $xsd 1]
+
+ # verify
+ soap::check_symbol $method
+
+ } error]
+
+ # verify
+ if { $err } {
+
+ # do nothing
+
+ } else {
+
+ # show
+ set error $xsd
+
+ # set fixed
+ set idl_style "C"
+
+ # get session values
+ set user_id [ad_conn user_id]
+ set peeraddr [ad_conn peeraddr]
+
+ # look for id of named method
+ set mid [soap::wsdl::method_get_id $namespace_id $method]
+
+ # verify
+ if { $mid > 0 && $mid != $editing_method } {
+
+ # egats
+ soap::fault::raise "Duplicate method: $method"
+
+ }
+
+ # test for assigned method id
+ if { $editing_method != 0 } {
+
+ # update existing
+ soap::server::lib::method_update $method_id $method $idl $idl_style $proc $method_notes
+
+ } else {
+
+ # create new
+ soap::server::lib::method_new $namespace_id $method $idl $idl_style $proc $method_notes $user_id $peeraddr $namespace_id
+ }
+
+ # clear editing mode
+ set editing_method 0
+
+ #ad_returnredirect "./edit-namespace"
+ }
+ }
+
+ # get diffs
+ array set diffs [soap::diff_methods -same t $service]
+
+ if { $editing_method } {
+
+ # query for method attributes
+ db_1row method_select {}
+
+ # store method_id into hidden form element
+ template::element create method_form method_id \
+ -widget hidden \
+ -datatype text \
+ -value $method_id
+
+ # set db method values into field elements
+ template::element set_value method_form idl $idl
+ template::element set_value method_form proc $proc
+ template::element set_value method_form method_notes $notes
+
+ } else {
+
+ # clear
+ template::element set_value method_form proc {}
+ template::element set_value method_form idl {}
+ template::element set_value method_form method_notes {}
+
+ }
+
+ # record history list of db entries
+ set history [list]
+
+ # query methods
+ db_multirow -extend {edit delete cancel diff} methods \
+ namespace_select_all {} {
+
+ # build hot links for edit/delete/...
+ set edit "edit-namespace?method_id=$method_id&namespace_id=$namespace_id"
+ set delete "delete-method?method_id=$method_id&namespace_id=$namespace_id"
+ set cancel "edit-namespace?namespace_id=$namespace_id"
+
+ # init diff code
+ set diff ERR
+
+ # try
+ if [catch {
+
+ # get the diff details for $method
+ set details $diffs($method)
+
+ # get the diff description code
+ set diff [lindex $details 0]
+
+ # add entry to history list
+ lappend history $method
+
+ # get the args
+ set proc [format "$proc {%s}" [lindex $details 1]]
+
+ # check for orphan
+ if [string equal -nocase -length 4 $diff ORPH] {
+
+ # modify proc to reflect orphan
+ set proc "#ORPHAN#"
+
+ }
+
+
+ } msg] {
+
+ # display error using proc
+ set proc $msg
+
+ }
+
+ # use hard spaces
+ regsub -all { } $proc {\ } proc
+ regsub -all { } $idl {\ } idl
+ }
+
+ # debug
+ #set diffdata [array get diffs]
+
+ # scan history list
+ foreach remove $history {
+
+ # remove entry from diffs array
+ array unset diffs $remove
+
+ }
+
+ # loop through remaining elements in diffs
+ foreach proc [array names diffs] {
+
+ # local
+ set local [namespace tail $proc]
+
+ # build import expression
+ set import "edit-namespace?namespace_id=$namespace_id&service=$service&import=1&proc=$local"
+
+ # get diff code
+ set diff [lindex $diffs($proc) 0]
+
+ # describe code
+ switch $diff {
+
+ UPUB {
+ set desc {*NOT PUBLISHED*}
+ }
+
+ DUPL {
+ set desc {*DUPLICATE IDL*}
+ }
+
+ default {
+ set desc {*UNKNOWN ERROR*}
+ }
+
+ }
+
+ # get proc
+ set local [format "$local {%s}" [lindex $diffs($proc) 1]]
+
+ # change to hard spaces
+ regsub -all { } $local {\ } local
+
+ # add to table
+ multirow append methods -1 $namespace_id {} $desc {} $local {} $import {} {} $diff
+
+ }
+
+ # create goto anchor
+ set focus "method_form.idl"
+
+} else {
+
+ # clear
+ set editing_method 0
+
+ # clear diffs
+ array set diffs [list empty {}]
+}
+
+
+
+# set context
+set context "Administration"
+
+# update caption for toolbar
+if $editing_namespace {
+
+ # set to edit
+ set caption "edit '$service'"
+
+ # create namespace var for help
+ set namespace [format "::sg::%s" $service]
+
+} else {
+
+ # set to create
+ set caption "create service"
+}
+
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/admin/index-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/index-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/index-postgresql.xql 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,11 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="namespace_list">
+ <querytext>
+ select namespace_id, service, uri, notes from sg_namespaces
+ </querytext>
+ </fullquery>
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/admin/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/index.adp 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,126 @@
+<master src="../master">
+<!-- property name="context">@context@</property -->
+<include src="../toolbar" caption="@caption@">
+<!-- link href="basic.css" rel="stylesheet" type="text/css" -->
+<if @namespaces:rowcount@ gt 0>
+<a name="top"></a>
+<table width="800" border=1 cellpadding=2 cellspacing=2>
+ <tr>
+ <td width="91" bgcolor=#cccccc><strong>Service</strong></td>
+ <td width="472" bgcolor=#cccccc><strong>Notes</strong></td>
+ <td width="50" bgcolor=#cccccc><strong>Status</strong></td>
+ <td width="37" bgcolor=#cccccc><strong>Edit</strong></td>
+ <td width="47" bgcolor=#cccccc><strong>Delete</strong></td>
+ <td width="51" bgcolor=#cccccc><strong>WSDL</strong></td>
+ </tr>
+ <multiple name="namespaces" rowcount=1>
+ <tr>
+ <td> <a href="#@namespaces.service@">
+ @namespaces.service@
+ </a> </td>
+ <td>
+ @namespaces.notes;noquote@
+ </td>
+ <td>@namespaces.status;noquote@</td>
+ <td><a href="@namespaces.edit@">edit</a></td>
+ <td><a href="@namespaces.delete@">delete</a></td>
+ <td><a href="@namespaces.wsdl@">wsdl</a></td>
+ </tr>
+ </multiple>
+</table>
+
+</if><else>
+<p><em>There are no namespaces</em></p>
+</else>
+<hr>
+<p><strong><u>Maintenance</u></strong></p>
+<ul>
+ <li><a href="libraries">Manage source libraries</a>.</li>
+ <!-- li><a href="edit-namespace">Create new namespace</a></li -->
+<if @unpublished:rowcount@ gt 0>
+ <multiple name="unpublished" rowcount=0>
+ <li>Import the following unpublished service: <a href="edit-namespace?service=@unpublished.service@&import=1">@unpublished.service@</a></li>
+ </multiple>
+</if>
+<if @ru_invoke@ eq 0>
+<b><em><font color="#FF0000"><li>
+Registered Users do not have 'invoke' privileges on the soap-gateway package! Go to Permissions.
+</li></font></em></b>
+</if>
+<if @pu_read@ eq 0>
+<b><em><font color="#FF0000"><li>
+The Public do not have 'read' privileges on the soap-gateway package! This may restrict clients from downloading WSDL service specifications. Go to Permissions.
+</if>
+</li></font></em></b>
+</ul>
+<p>Note: Only public procedures within the sg::<my-namespace>::* will be
+ imported. Comments are extracted<br>
+ from the source files and can modified once imported.</p>
+
+<if @namespaces:rowcount@ gt 0> <multiple name="namespaces">
+<hr size="1" width="800" align="left">
+<table width="800" border="0">
+ <tr>
+ <td width="129"><b><a name="@namespaces.service@"></a>Service:</b></td>
+ <td width="636"><b>
+ @namespaces.service@
+ </b> </td>
+ <td width="21"><a href="#"><img src="../top.gif" width="12" height="12" border="0"></a></td>
+ </tr>
+ <tr>
+ <td><b>Endpoint:</td>
+ <td></b><a href="@namespaces.endpoint@">
+ @namespaces.endpoint@
+ </a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td><b>WSDL:</td>
+ <td></b><a href="@namespaces.wsdl@">
+ @namespaces.wsdl@
+ </a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td> <em>force response:</em></td>
+ <td><a href="@namespaces.wsdl@&oneway=0">
+ @namespaces.wsdl@
+ &oneway=0</a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td> <em>no documentation:</em></td>
+ <td><a href="@namespaces.wsdl@&documentation=0">
+ @namespaces.wsdl@
+ &documentation=0</a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td> <em>trace:</em></td>
+ <td><a href="@namespaces.wsdl@&trace=http://localhost:8080">
+ @namespaces.wsdl@
+ &trace=http://localhost:8080</a></td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td><b>URI</b></td>
+ <td>
+ @namespaces.uri@
+ </td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td><b>SOAPAction</b></td>
+ <td>N/A</td>
+ <td> </td>
+ </tr>
+ <tr>
+ <td valign="top"><b>Notes:</td>
+ <td></b>
+ @namespaces.notes;noquote@ <a href="../doc/service?service=@namespaces.service@">(more)</a>
+ </td>
+ <td> </td>
+ </tr>
+</table>
+</multiple>
+</if>
Index: openacs-4/packages/soap-gateway/www/admin/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/index.tcl 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,97 @@
+# packages/soap-gateway/www/admin/index.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: index.tcl,v 1.1 2004/10/17 05:51:57 ncarroll Exp $
+} {
+}
+
+# clear title
+set title {}
+
+# installed correctly
+if [catch {
+
+ soap::server::lib::true 1
+
+}] {
+
+ # report as installation error
+ error "Failure while calling soap-gateway function!\nDid you restart the server after installing soap-gateway package?\n\n"
+
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id admin
+
+# query namespaces
+db_multirow -extend {endpoint edit delete wsdl status} namespaces namespace_list {} {
+ set endpoint [soap::wsdl::build_endpoint $service]
+ set edit "edit-namespace?namespace_id=$namespace_id"
+ set delete "delete-namespace?namespace_id=$namespace_id"
+ set wsdl [soap::wsdl::build_wsdl_url $service]
+
+ # check for problems
+ set diffs [soap::diff_methods $service]
+ if { [llength $diffs] > 0 } {
+ set status "<font color=\"#CC0000\">errors</font>"
+ } else {
+ set status "<font color=\"#00CC00\">ok</font>"
+ }
+}
+
+# get permission for object
+
+# get registered users
+set users [acs_magic_object registered_users]
+
+# test for invoke privileges on package for Registered_users
+set ru_invoke [soap::server::has_permission -user_id $users $package_id [soap::server::get_invoke_permission_moniker]]
+
+# get public
+set public [acs_magic_object the_public]
+
+# test for public read access on WSDL
+set pu_read 1;#[soap::server::has_permission -user_id $public $package_id read]
+
+# create form
+template::form create new_namespace_form
+
+# change action attribute for form - not documented
+set new_namespace_form:properties(action) edit-namespace
+
+# create form
+template::form create init_workspace_form
+
+# change action attribute for form - not documented
+set init_workspace_form:properties(action) init-workspace
+
+# create form
+template::form create init_interop_form
+
+# change action attribute for form - not documented
+set init_interop_form:properties(action) init-interop
+
+# create unpublished rowset
+multirow create unpublished service
+
+# get unpublished
+foreach s [soap::query_services -unpublished 1 -published 0] {
+
+ # add to multirow
+ multirow append unpublished $s
+
+}
+
+# set context
+set context "Administation"
+
+# update caption
+set caption "admin"
+
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/admin/libraries-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/libraries-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/libraries-postgresql.xql 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,11 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="library_list">
+ <querytext>
+ select library_id, path from sg_libraries
+ </querytext>
+ </fullquery>
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/admin/libraries.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/libraries.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/libraries.adp 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,64 @@
+<master src="../master">
+<!-- property name="context">@context@</property -->
+<include src="../toolbar" caption="@caption@">
+<a name="top"></a>
+<p> Enter the locations of the source files that will be available for importing
+ into the soap-gateway.<br>
+ Relative locations will be appended to the <em>acs_root </em>directory. Directory
+ watches will be converted<br>
+ to wildcard notation and will not recurse; e.g., soap-gateway/lib/*.tcl. The
+ files are <em>watched</em> by the<br>
+ Request Processor. <a href="libraries">Refresh</a> to update status.</p>
+<p>Once the source files are loaded, go back to the <a href=".">admin</a> and
+ import the services into the soap-gateway.<br>
+</p>
+<formtemplate id="library_form">
+<table width="800" border=1 cellpadding=2 cellspacing=2>
+ <tr>
+ <td width="760" bgcolor=#cccccc><strong>Path</strong></td>
+ <td width="20" bgcolor=#cccccc><strong>Status</strong></td>
+ <td width="20" bgcolor=#cccccc><strong>Watch</strong></td>
+ </tr>
+ <multiple name="libraries">
+ <tr>
+ <td>
+ @libraries.path@</a>
+ </td>
+ <td>
+ @libraries.status;noquote@
+ </td>
+ <td><a href="@libraries.remove@">remove</a></td>
+ </tr>
+ </multiple>
+ <tr>
+ <td><formwidget id="path"></a></td>
+ <td> </td>
+ <td><a href="javascript:document.library_form.submit();">add</a></td>
+ </tr>
+</table>
+</formtemplate><br>
+<table width="99%" border="0">
+ <tr>
+ <td width="4%"> </td>
+ <td width="10%"><u><strong>Status</strong></u></td>
+ <td width="86%"><u><strong>Meaning</strong></u></td>
+ </tr>
+ <tr>
+ <td> </td>
+ <td><font color="red">???</font></td>
+ <td>Library path returned no tcl source files</td>
+ </tr>
+ <tr>
+ <td> </td>
+ <td><font color="#00CC00">ok</font></td>
+ <td>All file timestamps in the path spec. coincide with APM</td>
+ </tr>
+ <tr>
+ <td> </td>
+ <td><font color="red">stale</font></td>
+ <td>At least one file timestamp in the path spec. does not coincide with APM</td>
+ </tr>
+</table>
+<p>
+ @stat@
+</p>
Index: openacs-4/packages/soap-gateway/www/admin/libraries.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/admin/libraries.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/admin/libraries.tcl 17 Oct 2004 05:51:57 -0000 1.1
@@ -0,0 +1,122 @@
+# packages/soap-gateway/www/admin/libraries.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: libraries.tcl,v 1.1 2004/10/17 05:51:57 ncarroll Exp $
+
+} {
+ library_id:integer,notnull,optional
+ {delete 0}
+ {path {}}
+ {update 0}
+ {force 0}
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id admin
+
+# clear status
+set stat {}
+
+# test for delete
+if [soap::server::lib::true $delete] {
+
+ # get current
+ set current [soap::server::lib::library_get_path $library_id]
+
+ # delete
+ soap::server::lib::library_delete $library_id
+
+ # stop watch
+ soap::server::lib::watch -stop 1 $current
+
+} elseif { $path != {} } {
+
+ # test for update
+ if [info exists library_id] {
+
+ # get current
+ set current [soap::server::lib::library_get_path $library_id]
+
+ # stop watch
+ soap::server::lib::watch -stop 1 $current
+
+ # update
+ soap::server::lib::library_update $library_id $path
+
+ # update - implicit watch
+ soap::server::lib::update_libraries [list $path]
+
+ } else {
+
+ if [catch {
+
+ # create new library
+ soap::server::lib::library_new $path
+
+ }] {
+
+ # report
+ set stat "Error creating new library path:<br> <em>$path</em><br>Possible duplicate."
+
+ } else {
+
+ # update - implicit watch
+ soap::server::lib::update_libraries [list $path]
+
+ }
+ }
+
+} elseif [soap::server::lib::true $update] {
+
+ # get path from id
+ set path [soap::server::lib::library_get_path $library_id]
+
+ # update
+ soap::server::lib::update_libraries [list $path]
+
+}
+
+# query namespaces
+db_multirow -extend {status remove} libraries library_list {} {
+ set remove "libraries?library_id=$library_id&delete=1"
+ if ![soap::server::lib::is_library_valid $path] {
+ set status "<font color=\"red\">???</font>"
+ } elseif [soap::server::lib::is_library_dirty $path] {
+ #set status "<font color=\"red\">stale</font>"
+ set status "<a href=\"libraries?library_id=$library_id&update=1\" style=\"color: red\">stale</a>"
+ } else {
+ set status "<font color=\"#00CC00\">ok</font>"
+ }
+
+}
+
+# clear path
+set path {}
+
+# create form
+template::form create library_form
+
+# build path input field
+template::element create library_form path \
+ -datatype text \
+ -label "Path" \
+ -html { size "100%" } \
+ -value {};
+
+# set up path
+template::element set_value library_form path "packages/<your-package>/lib/<your-source>.tcl"
+
+# set context
+set context "Administation"
+
+# update caption
+set caption "admin"
+
+# return template
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/doc/folder.gif
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/folder.gif,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/doc/html.bmp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/html.bmp,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/doc/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/doc/index.adp 17 Oct 2004 05:52:00 -0000 1.1
@@ -0,0 +1,120 @@
+<master src="@master@">
+<property name="context">@context@</property>
+<property name="context_bar">@context_bar@</property>
+<include src="../toolbar" caption="@caption@">
+<p><strong><font size="4" face="Arial, Helvetica, sans-serif"><a name="top"></a>soap-gateway</font></strong>
+</p>
+<p>William Byrne / <a href="mailto:WilliamB@ByrneLitho.com">WilliamB@ByrneLitho.com</a></p>
+<p>An experimental OpenACS SOAP package that may prove itself useful. </p>
+<p>Developed using the following system configuration:</p>
+<ul>
+ <li>RedHat 7.3</li>
+ <li>OpenACS 4.5 (nightly snapshot 10/3/2002) </li>
+ <li>AOLServer 3.3ad13</li>
+ <li>nsxml 1.4 </li>
+ <li>PostgreSQL 7.2.1</li>
+</ul>
+<p class="section"></p>
+<p><u><strong><a name="abstract"></a><span class="section">Abstract </span></strong></u></p>
+<p class="text">The soap-gateway is a compilation of server side tcl procedures
+ and pages that provide Remote Procedure Call (RPC) capabilities to OpenACS servers
+ for clients using SOAP/HTTP. The implementation is relatively small and maintains
+ minimal conformity to current SOAP specifications. This document describes the
+ basic implementation.</p>
+<p class="section"><u><a name="toc"></a>Table of Contents</u></p>
+<ol>
+ <li><a href="#Overview">Overview</a></li>
+ <li><a href="#Installation">Installation</a></li>
+ <li><a href="#Samples" title="Table of Contents">Samples</a></li>
+ <li><a href="#References">References</a></li>
+ <li><a href="#License">License</a></li>
+</ol>
+<p><a name="Overview" class="section"><u>Overview</u></a> <a href="#TOC" title="Table of Contents">(toc)</a></p>
+<p>The Simple Object Access Protocol (<a href="#SOAPv12">SOAP</a>) <a href="#SOAPv11">v1.1</a>
+ was <a href="#SOAPSubmission">submitted</a> to W3C on April 18, 2000. Its compatriot
+ Web Services Description Language (<a href="#WSDLv11">WSDL</a>) was <a href="#WSDLSubmission">submitted</a>
+ on March 14, 2001. Together they attempt to unify diverse systems using a form
+ of XML RPC. Most major software vendors are involved to some extent. Its future
+ looks bright. </p>
+<p>SOAP fits nicely into the Client/Server topology. Given a client that needs
+ some functionality available on a server, SOAP can be used to specify an operation
+ and its arguments to be submitted by the client to the server. At it's root,
+ the data representing the operation is fairly basic. If the connection between
+ the client and server were a TCP wire, a data trace would show about a page
+ of XML. The XML is not complex and is often decipherable at a glance. The XML
+ data is specified as a <a href="#SOAPv11">SOAP Envelope</a>. An evolving <a href="#SOAPv12">SOAP
+ specification</a> defines the Envelope and its progeny. The XML data transmitted
+ between the client and server is not arbitrary and should conform to a referenced
+ WSDL instance published by the server. It's the WSDL that defines the published
+ services and the invocation formats required for execution. The vast majority
+ of SOAP documentation demonstrates SOAP over HTTP. Another mentioned transport
+ is SMTP. In each case, the SOAP Envelope follows the respective header as an
+ XML Payload.</p>
+<p>Many web servers have been retrofitted to support a SOAP subsystem; e.g., Websphere,
+ Apache, iPlanet, IIS, etc. There are a handful of SOAP toolkits. To name a few,
+ <a href="#MSSOAP">MSSOAP Toolkit</a> from Microsoft, <a href="#Axis">AXIS</a>
+ from Apache, and <a href="#DataSnap">DataSnap</a> from Borland. A stand alone
+ Tcl implementation, <a href="#TclSOAP">TclSOAP,</a> is available at Source Forge.
+ In the <a href="#Implementation">Implementation</a> section, I'll get into the
+ details of my retrofit for OpenACS; the soap-gateway package. Client SOAP examples
+ using MSSOAP and AXIS can be found in the <a href="#Samples">Samples</a> section.</p>
+<p><a name="Installation" id="Installation"></a><u><span class="section">Installation</span></u>
+ <a href="#TOC" title="Table of Contents">(toc)</a></p>
+<p class="text">Here's a short list of steps required to enable SOAP/HTTP connectivity
+ to your server. The instructions are brief and assumes the reader has
+ administrative experience with OpenACS. More details will be available in
+ a subsequent release.</p>
+<ol>
+ <li>Select the SOAP Gateway from the list of packages that are available for
+ installation. Install it.</li>
+ <li>Create a sub-site under the Main site and call it 'soap'. </li>
+ <li>Create a new application by selecting the SOAP Gateway.</li>
+ <li>For now, call the new soap-gateway application SOAP Gateway. </li>
+ <li>Refresh this page so <a href="@base@admin" title="Adminitration">this admin
+ hot link</a> points to the soap-gateway admininistration pages.</li>
+ <li>Under the Maintenance section, you should see unpublished services: 'workspace'
+ and 'interop'. Import both.</li>
+ <li>In the same section, you may see a message that indicates 'Registered Users'
+ do not have 'invoke' access on the soap-gateway package. If so, go to the
+ <a href="@permissions@" title="Permissions">permissions</a> area for the soap-gateway
+ instance if you wish to grant 'invoke' rights to registered users.</li>
+ <li>Go to the <a href="#Samples">Samples</a> section and try the test samples.
+ Take note of the https warning when https'ing.</li>
+</ol>
+<p><strong>Note:</strong> Verify 'public' access to your installed 'soap-gateway'
+ using <em>http</em> and not <em>https</em>. Select the <a href="@base@">home</a>
+ of your 'soap-gateway' subsite to retrieve a listing of available services.
+ Also verify the WSDL for each service can be returned without the need to authenticate
+ into your server. This will allow clients to enumerate the published services
+ and retrieve the functional specification for each. Eliminating the need to
+ authenticate with the server for the purpose of retrieving service WSDLs removes
+ binding complications for client side SOAP tools.</p>
+<p>When importing a tcl library into the soap-gateway (i.e., any public methods
+ under the ::sg::<my-service> namespace), the soap-gateway automatically
+ grants public 'invoke' rights to any method named 'login'. This gives the client
+ an opportunity to authenticate into the server before making any other calls.</p>
+<p>Service libraries shipped with the soap-gateway are located in <em>packages/soap-gateway/lib</em>.</p>
+<p><a name="Samples"><u class="section">Samples</u></a> <a href="#TOC" title="Table of Contents">(toc)</a></p>
+<p>Sample SOAP client applications can be found <a href="@base@tests">here</a>. </p>
+<p><a name="References" class="section"><u>References</u></a> <a href="#TOC" title="Table of Contents">(toc)</a></p>
+<ul>
+ <li><a name="SOAPSubmission"></a>Simple Object Access Protocol (SOAP) Submission
+ <a href="http://www.w3.org/Submission/2000/05/" title="SOAP Submission" target="_blank">http://www.w3.org/Submission/2000/05/</a></li>
+ <li><a name="WSDLSubmission"></a>Web Services Description Language (WSDL) Submission
+ <a href="http://www.w3.org/Submission/2001/07/" title="WSDL Submission" target="_blank">http://www.w3.org/Submission/2001/07/</a></li>
+ <li><a name="SOAPv11"></a>SOAP v1.1 <a href="http://www.w3.org/TR/SOAP/" title="SOAP v1.1" target="_blank">http://www.w3.org/TR/SOAP/</a></li>
+ <li><a name="SOAPv12"></a>SOAP v1.2 Message Framework <a href="http://www.w3.org/TR/soap12-part1/" title="SOAP v1.2 Part 1" target="_blank">http://www.w3.org/TR/soap12-part1/</a></li>
+ <li><a name="WSDLv11"></a>WSDL v1.1 <a href="http://www.w3.org/TR/wsdl" title="WSDL v1.1" target="_blank">http://www.w3.org/TR/wsdl</a></li>
+ <li>XML Schema Part 0: Primer <a href="http://www.w3.org/TR/xmlschema-0/" title="XML Schema Part 0" target="_blank">http://www.w3.org/TR/xmlschema-0/</a></li>
+ <li>XML Schema Part 1: Structures <a href="http://www.w3.org/TR/xmlschema-1/" title="XML Schema Part 1" target="_blank">http://www.w3.org/TR/xmlschema-1/</a></li>
+ <li>XML Schema Part 2: Datatypes <a href="http://www.w3.org/TR/xmlschema-2/" title="XML Schema Part 2" target="_blank">http://www.w3.org/TR/xmlschema-2/</a></li>
+ <li><a name="MSSOAP"></a>Microsoft SOAP Toolkit <a href="http://msdn.microsoft.com/soap/" title="MS SOAP Toolkit" target="_blank">http://msdn.microsoft.com/soap/</a></li>
+ <li><a name="Axis"></a>Apache AXIS <a href="http://xml.apache.org/axis/" title="Apache AXIS" target="_blank">http://xml.apache.org/axis/</a></li>
+ <li><a name="DataSnap">Borland DataSnap</a> <a href="http://www.borland.com/delphi/dsnap/index.html" title="Borland DataSnap">http://www.borland.com/delphi/dsnap/index.html</a></li>
+ <li><a name="TclSOAP">TclSOAP </a><a href="http://tclsoap.sourceforge.net/" title="TclSOAP" target="_blank">http://tclsoap.sourceforge.net/</a></li>
+</ul>
+<p><a name="License" class="section" id="License"><u>License</u></a> <a href="#TOC" title="Table of Contents">(toc)</a></p>
+<p>The SOAP Gateway package is subject to the <a href="license.txt">Lesser General
+ Public License</a>.</p>
+</body>
+</html>
Index: openacs-4/packages/soap-gateway/www/doc/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/doc/index.tcl 17 Oct 2004 05:52:00 -0000 1.1
@@ -0,0 +1,59 @@
+# packages/soap-gateway/www/doc/index.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: index.tcl,v 1.1 2004/10/17 05:52:00 ncarroll Exp $
+} {
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id read
+
+# set context
+set context Documentation
+
+# set context bar
+set context_bar [ad_context_bar]
+
+# update caption
+set caption "help"
+
+# try
+if [catch {
+
+ # get href base
+ set base [soap::get_base_url]
+
+}] {
+
+ # report as installation error
+ error "Failure while calling soap-gateway function!\nDid you restart the server after installing soap-gateway package?\n\n"
+
+}
+
+# get package id
+set pid [soap::package_id -throw f]
+
+# set href
+set permissions "/permissions/one?object_id=$pid"
+
+# get master
+if { 1 || ![string equal [ad_conn package_key] "soap-gateway"] } {
+
+ # ???
+ set master "/packages/soap-gateway/www/master"
+
+} else {
+
+ # same place as base
+ set master "./$base/master"
+
+}
+
+# return template
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/doc/license.txt
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/license.txt,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/doc/license.txt 17 Oct 2004 05:52:01 -0000 1.1
@@ -0,0 +1,20 @@
+soap-gateway package for OpenACS
+Copyright (C) 2003 William Byrne
+
+This library is free software; you can redistribute it and/or
+modify it under the terms of the GNU Lesser General Public
+License as published by the Free Software Foundation; either
+version 2.1 of the License, or (at your option) any later version.
+
+This library is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+Lesser General Public License for more details.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+William Byrne
+WilliamB@ByrneLitho.com
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/doc/service-postgresql.xql
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/service-postgresql.xql,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/doc/service-postgresql.xql 17 Oct 2004 05:52:01 -0000 1.1
@@ -0,0 +1,23 @@
+<?xml version="1.0"?>
+
+<queryset>
+ <rdbms><type>postgresql</type><version>7.1</version></rdbms>
+
+ <fullquery name="namespace_select">
+ <querytext>
+ select service, uri, notes
+ from sg_namespaces
+ where namespace_id = :nid
+ </querytext>
+ </fullquery>
+
+ <fullquery name="methods_select">
+ <querytext>
+ select method_id, namespace_id, method, idl, idl_style, notes
+ from sg_methods
+ where namespace_id = :nid
+ order by method;
+ </querytext>
+ </fullquery>
+
+</queryset>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/doc/service.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/service.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/doc/service.adp 17 Oct 2004 05:52:01 -0000 1.1
@@ -0,0 +1,27 @@
+<master src="../master">
+<property name="context">@context@</property>
+<include src="../toolbar" caption="@caption@">
+<table border="0">
+<tr><td width="20"></td><td width="580">
+@service_notes@
+</td></td>
+</table>
+<table border="0">
+
+<multiple name="methods">
+<tr><td width="20"></td><td>
+<table width="580" >
+<tr style="margin-top: 8px"><td width="600">
+<hr size="1">
+<font face="Courier New, Courier, mono">
+@methods.pretty;noquote@
+</font>
+</td></tr>
+<tr><td>
+@methods.notes;noquote@
+</td></tr>
+</table>
+</td></tr>
+</multiple>
+
+</table>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/doc/service.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/service.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/doc/service.tcl 17 Oct 2004 05:52:01 -0000 1.1
@@ -0,0 +1,90 @@
+# packages/soap-gateway/www/doc/service.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: service.tcl,v 1.1 2004/10/17 05:52:01 ncarroll Exp $
+} {
+ service:notnull
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id read
+
+# get namespace id
+set nid [soap::server::namespace_get_id $service]
+
+# check
+if { $nid < 0 } {
+ # throw
+ soap::fault::raise "Invalid service: $service"
+}
+
+# query for namespace attributes
+db_1row namespace_select {}
+
+# preserve
+set service_notes $notes
+
+# query methods
+db_multirow -extend {pretty} methods methods_select {} {
+
+ # set up regexp expression for "C" style function
+ set expr [soap::wsdl::get_style_parser_expr C]
+
+ # invoke regexp
+ regexp $expr $idl {} rtyp meth argz
+
+ # get arg parser expr
+ set expr [soap::wsdl::get_style_parser_expr -argpart 1 C]
+
+ # decl pretty args
+ set pargs {}
+
+ # loop through args
+ foreach a [split $argz ,] {
+
+ # split arg type from its name
+ if ![regexp $expr $a {} atyp nam] {
+
+ # format problem
+ error "unexpected argument format: $a"
+
+ }
+
+ # add arg
+ if { $pargs == {} } {
+
+ # set
+ set pargs "<font color=\"blue\">$atyp</font> $nam"
+
+ } else {
+
+ # append
+ append pargs ", <font color=\"blue\">$atyp</font> $nam"
+
+ }
+
+ }
+
+ # make pretty
+ set pretty "<font color=\"blue\">$rtyp</font> <b>$meth</b>($pargs)"
+
+}
+
+# set context
+set context [list Documentation]
+
+# update caption
+set caption "$service service"
+
+# return template
+ad_return_template
+
+
+
+
Index: openacs-4/packages/soap-gateway/www/doc/tcl.gif
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/tcl.gif,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/doc/text.gif
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/text.gif,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/doc/www.gif
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/doc/www.gif,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/tests/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/index.adp 17 Oct 2004 05:52:02 -0000 1.1
@@ -0,0 +1,19 @@
+<master src="../master">
+<property name="context">@context@</property>
+<include src="../toolbar" caption="@caption@">
+<p><font face="Arial, Helvetica, sans-serif"><strong>Limited interoperability
+ tests</strong></font></p>
+<p><a href="mssoap" title="Microsoft SOAP Toolkit">Using Microsoft
+ SOAP Toolkit</a></p>
+<p><a href="axis">Using Apache AXIS Toolkit</a></p>
+<p>Refer to the <a href="@documentation@">soap-gateway documentation</a> for more
+ information on how to get the SOAP toolkits.</p>
+<if @http@ not nil>
+<p><em><strong><font color="#FF0000">SSL connections, SOAP/HTTPS, may not work
+ correctly. For testing, try launching the demo's using <a href="@http@">http</a>
+ instead of https. Service Side Certificates need to be trusted by the Client
+ software without the need for user confirmation. In other words, the SOAP toolkits
+ can't handle popup dialogs very well. And we usually get dialogs when the Server's
+ Certificate cannot be chained to a trusted authority. Free certificates are
+ available from freessl.com.</font></strong></em></p>
+</if>
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/tests/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/index.tcl 17 Oct 2004 05:52:02 -0000 1.1
@@ -0,0 +1,36 @@
+# packages/soap-gateway/www/tests/index.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: index.tcl,v 1.1 2004/10/17 05:52:02 ncarroll Exp $
+} {
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id read
+
+# set documentation path
+set documentation [file join [ad_conn object_url] doc]
+
+# set context
+set context "Tests"
+
+# update caption
+set caption "tests"
+
+# is this connection secure
+if [ad_secure_conn_p] {
+
+ # calc http name
+ set http [format "http://%s%s" [ns_info hostname] [file join / [soap::get_base_url] tests]]
+
+}
+
+# return template
+ad_return_template
+
Index: openacs-4/packages/soap-gateway/www/tests/axis/axis.zip
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/axis/axis.zip,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/tests/axis/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/axis/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/axis/index.adp 17 Oct 2004 05:52:04 -0000 1.1
@@ -0,0 +1,5 @@
+<master src="../../master">
+<property name="context">@context@</property>
+<include src="../../toolbar" caption="@caption@">
+Download the following <a href="axis.zip">archive</a> and refer to the enclosed documentation.<br>
+See the <a href="@references@">references</a> section for links to AXIS.
\ No newline at end of file
Index: openacs-4/packages/soap-gateway/www/tests/axis/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/axis/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/axis/index.tcl 17 Oct 2004 05:52:04 -0000 1.1
@@ -0,0 +1,27 @@
+# packages/soap-gateway/www/test/axis/index.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: index.tcl,v 1.1 2004/10/17 05:52:04 ncarroll Exp $
+} {
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id read
+
+# set context
+set context [list [list .. Tests] {AXIS}]
+
+# update caption
+set caption "axis toolkit"
+
+# update references
+set references [file join [ad_conn object_url] doc #References]
+
+# return template
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/bio-small.jpg
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/bio-small.jpg,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/bio.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/bio.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/mssoap/bio.adp 17 Oct 2004 05:52:05 -0000 1.1
@@ -0,0 +1,172 @@
+<master src="../../master">
+<property name="context">@context@</property>
+<include src="../../toolbar" caption="@caption@">
+<script language="VBScript">
+
+ dim Stub
+
+ sub window_onload
+
+ ' clear
+ set Stub = Nothing
+
+ end sub
+
+ sub DoInit
+
+ ' test
+ if not Stub is Nothing then exit sub
+
+ ' Create stub
+ set Stub = CreateObject("MSSOAP.SoapClient30")
+
+ ' specify desired service
+ service = "workspace"
+
+ ' get protocol and base location
+ base = location.protocol & "//" & location.host
+
+ ' build wsdl file location
+ WsdlFile = base & "/soap/wsdl?service=" & service
+
+ ' get trace
+ trace = document.frm.txtTrace.value
+
+ ' test
+ if trace <> "" then
+
+ ' add trace info
+ WsdlFile = WsdlFile & "&trace=" & trace
+
+ end if
+
+ ' test for oneway disable
+ if document.frm.chkOneway.checked then
+
+ ' add disable flag
+ WsdlFile = WsdlFile & "&oneway=0"
+
+ end if
+
+ ' build service namespace
+ Namespace = "http://" & service & ".openacs.org/wsdl/"
+
+ ' initialize stub
+ Stub.MSSoapInit2 WsdlFile, "", service, service & "SoapPort", Namespace
+
+ ' disable
+ document.frm.chkOneway.disabled = True
+ document.frm.txtTrace.disabled = True
+
+ end sub
+
+ sub DoLogin
+
+ ' init
+ DoInit
+
+ ' get form params
+ user = document.frm.txtUser.value
+ password = document.frm.txtPassword.value
+
+ ' invoke
+ call Stub.login(user, password)
+
+ ' enabled/disable button
+ document.frm.btnLogin.disabled = True
+ document.frm.btnLogout.disabled = False
+ document.frm.txtFirstname.disabled = False
+ document.frm.txtLastname.disabled = False
+ document.frm.btnUpdate.disabled = False
+
+ ' get name
+ parts = Split(Stub.getName(), " ")
+
+ ' set first
+ document.frm.txtFirstname.value = Trim(parts(0))
+
+ ' set last
+ if UBound(parts) > 0 then
+ document.frm.txtLastname.value = Trim(parts(1))
+ end if
+
+
+
+ end sub
+
+ sub DoLogout
+
+ ' init
+ DoInit
+
+ ' invoke
+ call Stub.logout()
+
+ ' enabled/disable button
+ document.frm.btnUpdate.disabled = True
+ document.frm.btnLogin.disabled = False
+ document.frm.btnLogout.disabled = True
+ document.frm.txtFirstname.disabled = True
+ document.frm.txtLastname.disabled = True
+ document.frm.txtFirstname.value = ""
+ document.frm.txtLastname.value = ""
+ document.frm.txtPassword.value = ""
+
+ end sub
+
+ sub DoUpdate
+
+ ' init
+ DoInit
+
+ ' get form params
+ firstname = document.frm.txtFirstname.value
+ lastname = document.frm.txtLastname.value
+
+ ' invoke
+ call Stub.setName(firstname, lastname)
+
+ ' ok
+ MsgBox "OK"
+
+ end sub
+
+</script>
+<h3>workspace::setName</h3>
+<form name="frm">
+ <table width="320" height="114" border="1">
+ <tr>
+ <td align="left"> <input type="text" name="txtUser"> User<br>
+ <input type="password" name="txtPassword"> Password </td>
+ </tr>
+ <tr>
+ <td align="center">
+ <input name="btnLogin" type="button" onClick="DoLogin" value="Login" language="VBScript">
+
+ <input name="btnLogout" type="button" disabled="true" onClick="DoLogout" value="Logout" language="VBScript">
+ </td>
+ </tr>
+ </table><br>
+ <table width="320" border="1">
+ <tr>
+ <td height="61" align="left">
+ <input name="txtFirstname" type="text" disabled="true" id="txtFirstname">
+ First Name<br>
+ <input name="txtLastname" type="text" disabled="true" id="txtLastname">
+ Last Name</td>
+ </tr>
+ <tr>
+ <td height="43" align="center">
+ <input name="btnUpdate" type="button" disabled="true" id="btnUpdate" onClick="DoUpdate" value="Update" language="VBScript">
+ </td>
+ </tr>
+ </table>
+ <br>
+ <table width="320" border="1" bordercolor="#000000">
+ <tr>
+ <td width="100%" bordercolor="#000000">Debug Trace (e.g., http://locahost:8080)<br> <input type="text" name="txtTrace">
+ <br> <input type="checkbox" name="chkOneway" checked="true">
+ Disable one-way's</td>
+ </tr>
+ </table>
+</form>
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/bio.jpg
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/bio.jpg,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/bio.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/bio.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/mssoap/bio.tcl 17 Oct 2004 05:52:05 -0000 1.1
@@ -0,0 +1,24 @@
+# packages/soap-gateway/www/test/mssoap/index.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: bio.tcl,v 1.1 2004/10/17 05:52:05 ncarroll Exp $
+} {
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id read
+
+# set context
+set context [list [list .. Tests] {MS SOAP}]
+
+# update caption
+set caption "bio test"
+
+# return template
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/echo-small.jpg
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/echo-small.jpg,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/echo.jpg
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/echo.jpg,v
diff -u
Binary files differ
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/index.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/index.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/mssoap/index.adp 17 Oct 2004 05:52:05 -0000 1.1
@@ -0,0 +1,24 @@
+<master src="../../master">
+<property name="context">@context@</property>
+<include src="../../toolbar" caption="@caption@">
+<table width="640""0">
+ <tr>
+ <td> To run the following tests, you'll need IE and the <a href="@references@">MSSOAP
+ Toolkit</a><br>
+</td></tr>
+<tr><td>
+More than likely, you'll experience a security issue when attempting to instantiate the
+MSSOAP Toolkit from within a page that originated from an untrusted server. Adding your trusted server to the list of <a href="trusted.jpg">Trusted Servers</a> in IE should help.
+</td></tr>
+</table>
+<br>
+<table width="499" height="394" border="1" align="center">
+ <tr>
+ <td width="239" height="388" align="center" valign="bottom">
+ <p><a href="echo.jpg"><img src="echo-small.jpg" width="200" height="303" border="0"></a></p>
+ <p><a href="interop">Basic Interop Tests</a></p></td>
+ <td width="244" align="center" valign="bottom">
+ <p><a href="bio.jpg"><img src="bio-small.jpg" width="194" height="285" border="0"></a></p>
+ <p><a href="bio">User Bio</a></p></td>
+ </tr>
+</table>
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/index.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/index.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/mssoap/index.tcl 17 Oct 2004 05:52:05 -0000 1.1
@@ -0,0 +1,27 @@
+# packages/soap-gateway/www/test/mssoap/index.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: index.tcl,v 1.1 2004/10/17 05:52:05 ncarroll Exp $
+} {
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id read
+
+# set context
+set context [list [list .. Tests] {MS SOAP}]
+
+# update caption
+set caption "mssoap toolkit"
+
+# update references
+set references [file join [ad_conn object_url] doc #References]
+
+# return template
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/interop.adp
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/interop.adp,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/mssoap/interop.adp 17 Oct 2004 05:52:05 -0000 1.1
@@ -0,0 +1,198 @@
+<master src="../../master">
+<property name="context">@context@</property>
+<include src="../../toolbar" caption="@caption@">
+<script language="VBScript">
+
+ dim Stub
+
+ sub window_onload
+
+ ' clear
+ set Stub = Nothing
+
+ end sub
+
+ sub DoInit
+
+ ' test
+ if not Stub is Nothing then exit sub
+
+ ' Create stub
+ set Stub = CreateObject("MSSOAP.SoapClient30")
+
+ ' specify desired service
+ service = "interop"
+
+ ' get protocol and base location
+ base = location.protocol & "//" & location.host
+
+ ' build wsdl file location
+ WsdlFile = base & "/soap/wsdl?service=" & service
+
+ ' get trace
+ trace = document.frm.txtTrace.value
+
+ ' test
+ if trace <> "" then
+
+ ' add trace info
+ WsdlFile = WsdlFile & "&trace=" & trace
+
+ end if
+
+ ' test for oneway disable
+ if document.frm.chkOneway.checked then
+
+ ' add disable flag
+ WsdlFile = WsdlFile & "&oneway=0"
+
+ end if
+
+ ' build service namespace
+ Namespace = "http://" & service & ".openacs.org/wsdl/"
+
+ ' initialize stub
+ Stub.MSSoapInit2 WsdlFile, "", service, service & "SoapPort", Namespace
+
+ ' disable
+ document.frm.chkOneway.disabled = True
+ document.frm.txtTrace.disabled = True
+
+ end sub
+
+ sub DoLogin
+
+ ' init
+ DoInit
+
+ ' get form params
+ user = document.frm.txtUser.value
+ password = document.frm.txtPassword.value
+
+ ' invoke
+ call Stub.login(user, password)
+
+ ' enabled/disable button
+ document.frm.btnLogin.disabled = True
+ document.frm.btnLogout.disabled = False
+
+ end sub
+
+ sub DoLogout
+
+ ' init
+ DoInit
+
+ ' invoke
+ call Stub.logout()
+
+ ' enabled/disable button
+
+ document.frm.btnLogin.disabled = False
+ document.frm.btnLogout.disabled = True
+
+ end sub
+
+ sub DoEchoString
+
+ ' init
+ DoInit
+
+ ' get form params
+ echo = document.frm.txtEchoString.value
+
+ ' invoke and show results
+ MsgBox Stub.echoString(echo)
+
+ end sub
+
+ sub DoEchoInteger
+
+ ' init
+ DoInit
+
+ ' get form params
+ echo = document.frm.txtEchoInteger.value
+
+ ' invoke and show results
+ MsgBox Stub.echoInteger(echo)
+
+ end sub
+
+ sub DoEchoFloat
+
+ ' init
+ DoInit
+
+ ' get form params
+ echo = document.frm.txtEchoFloat.value
+
+ ' invoke and show results
+ MsgBox Stub.echoFloat(echo)
+
+ end sub
+
+ sub DoEchoVoid
+
+ ' init
+ DoInit
+
+ ' get form params
+ echo = document.frm.txtEchoVoid.value
+
+ ' invoke and show results
+ Stub.echoVoid
+
+ end sub
+
+</script>
+<h3>interop::echo* test</h3>
+<form name="frm">
+ <table width="320" height="114" border="1">
+ <tr>
+ <td align="left"> <input type="text" name="txtUser"> User<br>
+ <input type="password" name="txtPassword"> Password </td>
+ </tr>
+ <tr>
+ <td align="center">
+ <input name="btnLogin" type="button" onClick="DoLogin" value="Login" language="VBScript">
+
+ <input name="btnLogout" type="button" disabled="true" onClick="DoLogout" value="Logout" language="VBScript">
+ </td>
+ </tr>
+ </table>
+ <br>
+ <table width="320" border="1">
+ <tr>
+ <td width="61">String</td>
+ <td width="161"><input name="txtEchoString" type="text" id="txtEchoString" value="this is an echo"></td>
+ <td width="76" align="center">
+ <input name="btnEchoString" type="button" id="btnEchoString" onClick="DoEchoString" value="Echo" language="VBScript">
+ </td>
+ </tr>
+ <tr>
+ <td>Integer</td>
+ <td><input name="txtEchoInteger" type="text" id="txtEchoInteger" value="123456"></td>
+ <td align="center"><input name="btnEchoInteger" type="button" id="btnEchoInteger" onClick="DoEchoInteger" value="Echo" language="VBScript"></td>
+ </tr>
+ <tr>
+ <td>Float</td>
+ <td><input name="txtEchoFloat" type="text" id="txtEchoFloat" value="123.45"></td>
+ <td align="center"><input name="btnEchoFloat" type="button" id="btnEchoFloat" onClick="DoEchoFloat" value="Echo" language="VBScript"></td>
+ </tr>
+ <tr>
+ <td>Void</td>
+ <td><input name="txtEchoVoid" type="text" id="txtEchoVoid"></td>
+ <td align="center"><input name="btnEchoVoid" type="button" id="btnEchoVoid" onClick="DoEchoVoid" value="Echo" language="VBScript"></td>
+ </tr>
+ </table>
+ <br>
+ <br>
+ <table width="320" border="1" bordercolor="#000000">
+ <tr>
+ <td width="100%" bordercolor="#000000">Debug Trace (e.g., http://locahost:8080)<br> <input type="text" name="txtTrace">
+ <br> <input type="checkbox" name="chkOneway" checked="true">
+ Disable one-way's</td>
+ </tr>
+ </table>
+</form>
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/interop.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/interop.tcl,v
diff -u
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/soap-gateway/www/tests/mssoap/interop.tcl 17 Oct 2004 05:52:05 -0000 1.1
@@ -0,0 +1,24 @@
+# packages/soap-gateway/www/test/mssoap/interop.tcl
+
+ad_page_contract {
+
+ @author WilliamB@ByrneLitho.com
+ @creation-date 2002-12-23
+ @cvs-id $Id: interop.tcl,v 1.1 2004/10/17 05:52:05 ncarroll Exp $
+} {
+}
+
+# get package id
+set package_id [ad_conn package_id]
+
+# require read permission
+ad_require_permission $package_id read
+
+# set context
+set context [list [list .. Tests] {MS SOAP}]
+
+# update caption
+set caption "interop test"
+
+# return template
+ad_return_template
Index: openacs-4/packages/soap-gateway/www/tests/mssoap/trusted.jpg
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/soap-gateway/www/tests/mssoap/trusted.jpg,v
diff -u
Binary files differ