CREATE OR REPLACE PACKAGE utl_jabber
    IS

    /*
    begin
      -- UTL_JABBER.debug( true );
      IF ( UTL_JABBER.attach( 'testserver' )) THEN
        IF ( UTL_JABBER.logon( 'test', 'password', false )) THEN
          UTL_JABBER.status( UTL_JABBER.STATUS_ONLINE, 'Hello world!' );
          UTL_JABBER.send( 'user@'testserver', 'Message' );
        END IF;
        UTL_JABBER.detach;
      END IF;
      EXCEPTION WHEN OTHERS THEN
        UTL_TCP.CLOSE_ALL_CONNECTIONS;
    end;
    */

    FUNCTION attach(v_host IN VARCHAR2,
                                    v_hostname IN VARCHAR2 := NULL,
                                    v_port IN NUMBER := 5222)
        RETURN BOOLEAN;
    PROCEDURE detach;

    FUNCTION logon(v_user IN VARCHAR2,
                                 v_password IN VARCHAR2,
                                 b_plaintext IN BOOLEAN := TRUE)
        RETURN BOOLEAN;

    status_online CONSTANT PLS_INTEGER := 0;
    status_offline CONSTANT PLS_INTEGER := 1;
    status_invisible CONSTANT PLS_INTEGER := 2;
    status_chat CONSTANT PLS_INTEGER := 3;
    status_away CONSTANT PLS_INTEGER := 4;
    status_na CONSTANT PLS_INTEGER := 5;
    status_dnd CONSTANT PLS_INTEGER := 6;
    PROCEDURE status(n_value IN PLS_INTEGER,
                                     v_note IN VARCHAR2 := NULL,
                                     n_priority IN NUMBER := 5);

    PROCEDURE send(v_to IN VARCHAR2,
                                 v_message IN VARCHAR2);
    PROCEDURE debug(b_enable IN BOOLEAN);

END utl_jabber;
/

CREATE OR REPLACE PACKAGE BODY user_setup.utl_jabber
    IS
    tcp_timeout_min NUMBER(1, 3) := 0.001;
    tcp_timeout_max NUMBER(2, 0) := 2;
    vc_resource CONSTANT VARCHAR2(10 CHAR) := 'utl_jabber';

    tcp_connection UTL_TCP.connection := NULL;
    v_session_id VARCHAR2(256 CHAR) := NULL;
    v_hostconnect VARCHAR2(1024 CHAR) := NULL;
    b_connect BOOLEAN := FALSE;
    b_logon BOOLEAN := FALSE;
    b_debug BOOLEAN := FALSE;
    n_status PLS_INTEGER := status_offline;

    TYPE t_iq IS RECORD (
            id              VARCHAR2(256 CHAR),
            TYPE            VARCHAR2(256 CHAR),
            xmlns           VARCHAR2(256 CHAR),
            sender      VARCHAR2(1024 CHAR),
            recipient VARCHAR2(1024 CHAR),
            BODY            VARCHAR2(32767 CHAR)
        );

    TYPE t_message IS RECORD (
            id              VARCHAR2(256 CHAR),
            TYPE            VARCHAR2(256 CHAR),
            recipient VARCHAR2(1024 CHAR),
            BODY            VARCHAR2(32767 CHAR)
        );

    TYPE t_presence IS RECORD (
            TYPE         VARCHAR2(12 CHAR),
            isshow   BOOLEAN,
            status   VARCHAR2(256 CHAR),
            priority NUMBER
        );

    PROCEDURE put(v_string IN VARCHAR2,
                                len_delimiter IN NUMBER := 250)
        IS
            v_startloc PLS_INTEGER DEFAULT 0;
            v_endloc PLS_INTEGER DEFAULT 0;
            v_len PLS_INTEGER;
            v_atom VARCHAR2(255 CHAR);
        BEGIN
            IF (v_string IS NOT NULL) THEN
                v_len := LENGTH(v_string);
                LOOP
                    v_endloc := LEAST(v_len, NVL(len_delimiter, 250) + v_startloc);
                    v_atom := SUBSTR(v_string, v_startloc, v_endloc - v_startloc + 1);
                    DBMS_OUTPUT.put_line(v_atom);
                    v_startloc := v_endloc - 1;
                    EXIT WHEN v_endloc = v_len;
                END LOOP;
            END IF;
        EXCEPTION
            WHEN OTHERS THEN NULL;
        END put;

    FUNCTION md5(v_value IN VARCHAR2)
        RETURN VARCHAR2 deterministic
        IS
        BEGIN
            RETURN UTL_RAW.cast_to_raw(DBMS_OBFUSCATION_TOOLKIT.md5(input_string => v_value));
        END md5;

    PROCEDURE fix_id(v_id IN OUT VARCHAR2)
        IS
        BEGIN
            IF (v_id IS NULL) THEN
                v_id := md5(TO_CHAR(SYSDATE, 'YYYYMMDDHH24MISS') || SYS_CONTEXT('USERENV', 'IP_ADDRESS') || DBMS_RANDOM.VALUE);
            END IF;
        END fix_id;

    PROCEDURE debug(b_enable IN BOOLEAN)
        IS
        BEGIN
            b_debug := b_enable;
        END debug;

    FUNCTION value_get(v_xml IN VARCHAR2,
                                         v_element IN VARCHAR2,
                                         v_attribute IN VARCHAR2)
        RETURN VARCHAR2
        IS
            n_pos PLS_INTEGER;
            n_last PLS_INTEGER;
            v_answer VARCHAR2(32767 CHAR);
            v_result VARCHAR2(32767 CHAR);
        BEGIN
            v_result := NULL;
            v_answer := REPLACE(v_xml, '''', NULL);
            v_answer := REPLACE(v_answer, '"', NULL);
            n_pos := INSTR(v_answer, v_attribute, INSTR(v_answer, v_element)) + LENGTH(v_attribute) + 1;
            IF (n_pos > LENGTH(v_attribute) + 1) THEN
                n_last := INSTR(v_answer, ' ', n_pos);
                IF (n_last = 0) THEN
                    n_last := INSTR(v_answer, '>', n_pos);
                ELSE
                    n_last := LEAST(n_last, INSTR(v_answer, '>', n_pos));
                END IF;
                v_result := SUBSTR(v_answer, n_pos, n_last - n_pos);
            END IF;
            RETURN v_result;
        END value_get;

    PROCEDURE server_logoff
        IS
        BEGIN
            b_connect := FALSE;
            UTL_TCP.close_connection(tcp_connection);
        EXCEPTION
            WHEN OTHERS THEN IF (b_debug) THEN
                        put(SQLERRM);
                    END IF;
        END server_logoff;

    PROCEDURE server_logon(v_host IN VARCHAR2,
                                                 n_port IN NUMBER := 5222)
        IS
        BEGIN
            IF (b_connect) THEN
                server_logoff;
            END IF;
            tcp_connection := UTL_TCP.open_connection(v_host, n_port);
            b_connect := TRUE;
        EXCEPTION
            WHEN OTHERS THEN b_connect := FALSE;
                    IF (b_debug) THEN
                        put(SQLERRM);
                    END IF;
        END server_logon;

    FUNCTION server_read
        RETURN VARCHAR2
        IS
            v_char VARCHAR2(1 CHAR);
            v_result VARCHAR2(32767 CHAR);
            n_timeout NUMBER(5, 3);
        BEGIN
            v_result := NULL;
            n_timeout := 0;
            WHILE (v_result IS NULL)
                AND (n_timeout < tcp_timeout_max) LOOP
                    --    DBMS_LOCK.SLEEP( tcp_timeout_min );
                    --    WHILE UTL_TCP.AVAILABLE( tcp_connection ) > 0 LOOP
                    WHILE UTL_TCP.available(tcp_connection, tcp_timeout_min) > 0 LOOP
                            v_char := UTL_TCP.get_text(tcp_connection);
                            v_result := v_result || v_char;
                        END LOOP;
                    n_timeout := n_timeout + tcp_timeout_min;
                END LOOP;
            IF (b_debug) THEN
                put('TIMEOUT:' || n_timeout);
                put(v_result);
            END IF;
            RETURN v_result;
        EXCEPTION
            WHEN OTHERS THEN IF (b_debug) THEN
                        put(v_result);
                        put(SQLERRM);
                    END IF;
                    RETURN v_result;
        END server_read;

    PROCEDURE server_send(v_pack IN VARCHAR2)
        IS
            v_bytes PLS_INTEGER;
        BEGIN
            IF (b_debug) THEN
                put(v_pack);
            END IF;
            IF (b_connect) THEN
                IF (v_pack IS NOT NULL) THEN
                    v_bytes := UTL_TCP.write_line(tcp_connection, CONVERT(v_pack, 'UTF8'));
                ELSE
                    v_bytes := UTL_TCP.write_line(tcp_connection);
                END IF;
            END IF;
        EXCEPTION
            WHEN OTHERS THEN IF (b_debug) THEN
                        put('get ' || v_bytes || ' bytes');
                        put(SQLERRM);
                    END IF;
        END server_send;

    FUNCTION pack_iq(iq IN OUT t_iq)
        RETURN VARCHAR2 deterministic
        IS
            v_pack VARCHAR2(32767 CHAR);
        BEGIN
            fix_id(iq.id);
            v_pack := '<iq type="' || iq.TYPE || '" id="' || iq.id || '"';
            IF (iq.recipient IS NOT NULL) THEN
                v_pack := v_pack || ' to="' || iq.recipient || '"';
            END IF;
            IF (iq.sender IS NOT NULL) THEN
                v_pack := v_pack || ' from="' || iq.sender || '"';
            END IF;
            v_pack := v_pack || '>';
            IF (iq.xmlns IS NOT NULL) THEN
                v_pack := v_pack || '<query xmlns="' || iq.xmlns || '"';
                IF (iq.BODY IS NOT NULL) THEN
                    v_pack := v_pack || '>' || iq.BODY || '</query>';
                ELSE
                    v_pack := v_pack || '/>';
                END IF;
            END IF;
            v_pack := v_pack || '</iq>';
            RETURN v_pack;
        END pack_iq;

    FUNCTION pack_message(message IN OUT t_message)
        RETURN VARCHAR2 deterministic
        IS
            v_pack VARCHAR2(32767 CHAR);
        BEGIN
            fix_id(message.id);
            v_pack := '<message';
            IF (message.TYPE IS NOT NULL) THEN
                v_pack := v_pack || ' type="' || message.TYPE || '"';
            END IF;
            v_pack := v_pack || ' id="' || message.id || '"';
            IF (message.recipient IS NOT NULL) THEN
                v_pack := v_pack || ' to="' || message.recipient || '"';
            END IF;
            v_pack := v_pack || '>';
            IF (message.BODY IS NOT NULL) THEN
                v_pack := v_pack || '<body>' || message.BODY || '</body>';
            END IF;
            v_pack := v_pack || '<x xmlns="jabber:x:event"><composing/></x></message>';
            RETURN v_pack;
        END pack_message;

    FUNCTION pack_presence(presence IN t_presence)
        RETURN VARCHAR2 deterministic
        IS
            v_pack VARCHAR2(32767 CHAR);
        BEGIN
            v_pack := '<presence';
            IF (NOT presence.isshow) THEN
                v_pack := v_pack || ' type="' || presence.TYPE || '"';
            END IF;
            v_pack := v_pack || '>';
            IF ((presence.isshow) AND (presence.TYPE IS NOT NULL)) THEN
                v_pack := v_pack || '<show>' || presence.TYPE || '</show>';
            END IF;
            IF (presence.status IS NOT NULL) THEN
                v_pack := v_pack || '<status>' || presence.status || '</status>';
            END IF;
            IF (presence.priority IS NOT NULL) THEN
                v_pack := v_pack || '<priority>' || presence.priority || '</priority>';
            END IF;
            RETURN v_pack || '</presence>';
        END pack_presence;

    PROCEDURE stream_start
        IS
            v_answer VARCHAR2(32767 CHAR);
        BEGIN
            server_send('<?xml version="1.0" encoding="utf-8" ?>');
            server_send('<stream:stream xmlns:stream="http://etherx.jabber.org/streams" xmlns="jabber:client" to="' || v_hostconnect || '">');
            v_answer := server_read;
            v_session_id := value_get(v_answer, 'stream:stream', 'id');
            IF (b_debug) THEN
                put('Session Id:' || v_session_id);
            END IF;
        END stream_start;

    PROCEDURE stream_end
        IS
        BEGIN
            server_send('</stream:stream>');
        END stream_end;

    PROCEDURE auth_get(v_user IN VARCHAR2,
                                         v_md5 IN OUT VARCHAR2)
        IS
            iq t_iq;
        BEGIN
            iq.id := v_md5;
            iq.TYPE := 'get';
            iq.xmlns := 'jabber:iq:auth';
            iq.recipient := v_hostconnect;
            iq.BODY := v_user;
            server_send(pack_iq(iq));
            v_md5 := iq.id;
        END auth_get;

    PROCEDURE auth_set(v_user IN VARCHAR2,
                                         v_password IN VARCHAR2,
                                         v_resource IN VARCHAR2,
                                         v_md5 IN OUT VARCHAR2)
        IS
            iq t_iq;
        BEGIN
            iq.id := v_md5;
            iq.TYPE := 'set';
            iq.xmlns := 'jabber:iq:auth';
            iq.recipient := v_hostconnect;
            iq.BODY := v_user || v_password || v_resource;
            server_send(pack_iq(iq));
            v_md5 := iq.id;
        END auth_set;

    FUNCTION logon(v_user IN VARCHAR2,
                                 v_password IN VARCHAR2,
                                 b_plaintext IN BOOLEAN := TRUE)
        RETURN BOOLEAN
        IS
            v_md5 VARCHAR2(32 CHAR);
            v_auth_usr VARCHAR2(256 CHAR);
            v_auth_pwd VARCHAR2(256 CHAR);
            v_resource VARCHAR2(256 CHAR);
            v_answer VARCHAR2(32767 CHAR);

            FUNCTION username(v_user IN VARCHAR2)
                RETURN VARCHAR2 deterministic
                IS
                    n_pos PLS_INTEGER;
                    v_name VARCHAR2(256 CHAR);
                BEGIN
                    n_pos := INSTR(v_user, '@') - 1;
                    IF (n_pos > 0) THEN
                        v_name := SUBSTR(v_user, 1, n_pos);
                    ELSE
                        v_name := SUBSTR(v_user, 1);
                    END IF;
                    RETURN TRIM(v_name);
                END username;

        BEGIN
            IF (NOT b_logon) THEN
                v_md5 := NULL;
                v_auth_usr := '<username>' || username(v_user) || '</username>';
                auth_get(v_auth_usr, v_md5);
                v_answer := server_read;
                IF (value_get(v_answer, 'iq', 'type') = 'result') THEN
                    v_md5 := NULL;
                    IF ((b_plaintext) OR (v_session_id IS NULL)) THEN
                        v_auth_pwd := '<password>' || v_password || '</password>';
                    ELSE
                        raise_application_error(-20100, 'digest auth not implemented for 9i');
                    -- v_auth_pwd := '<digest>' || LOWER( DBMS_CRYPTO.HASH( UTL_RAW.CAST_TO_RAW( CONVERT( v_session_id || v_password, 'UTF8' )), DBMS_CRYPTO.HASH_SH1 )) || '</digest>';
                    END IF;
                    v_resource := '<resource>' || vc_resource || '</resource>';
                    auth_set(v_auth_usr, v_auth_pwd, v_resource, v_md5);
                    v_answer := server_read;
                    b_logon := (value_get(v_answer, 'iq', 'type') = 'result');
                END IF;
            END IF;
            RETURN b_logon;
        END logon;

    PROCEDURE logoff
        IS
        BEGIN
            status(status_offline);
            b_logon := FALSE;
        END logoff;

    FUNCTION attach(v_host IN VARCHAR2,
                                    v_hostname IN VARCHAR2 := NULL,
                                    v_port IN NUMBER := 5222)
        RETURN BOOLEAN
        IS
        BEGIN
            IF (NOT b_connect) THEN
                server_logon(v_host, v_port);
                IF (b_connect) THEN
                    IF (v_hostname IS NULL) THEN
                        v_hostconnect := v_host;
                    ELSE
                        v_hostconnect := v_hostname;
                    END IF;
                    stream_start;
                END IF;
            END IF;
            RETURN b_connect;
        END attach;

    PROCEDURE detach
        IS
        BEGIN
            logoff;
            stream_end;
            server_logoff;
        END detach;

    PROCEDURE status(n_value IN PLS_INTEGER,
                                     v_note IN VARCHAR2 := NULL,
                                     n_priority IN NUMBER := 5)
        IS
            presence t_presence;
        BEGIN
            --IF ( n_status <> n_value ) THEN
            CASE n_value
                WHEN status_na THEN presence.TYPE := 'xa';
                WHEN status_dnd THEN presence.TYPE := 'dnd';
                WHEN status_away THEN presence.TYPE := 'away';
                WHEN status_chat THEN presence.TYPE := 'chat';
                WHEN status_offline THEN presence.TYPE := 'unavailable';
                WHEN status_invisible THEN presence.TYPE := 'invisible';
                ELSE NULL;
            END CASE;
            presence.isshow := (n_value NOT IN (status_offline, status_invisible));
            presence.status := v_note;
            presence.priority := n_priority;
            server_send(pack_presence(presence));
            n_status := n_value;
        --END IF;
        END status;

    PROCEDURE send(v_to IN VARCHAR2,
                                 v_message IN VARCHAR2)
        IS
            message t_message;
        BEGIN
            IF (b_connect) THEN
                message.TYPE := 'chat';
                message.recipient := v_to;
                message.BODY := v_message;
                server_send(pack_message(message));
            ELSE
                IF (b_debug) THEN
                    put('Logon need');
                END IF;
            END IF;
        END send;

END utl_jabber;