::obexTop, Main, Index

method constructor {args} {

    namespace path [linsert [namespace path] end ::obex ::obex::core]
    my reset
    if {[llength [self next]]} {
        next {*}$args
    }
}

method abort {{headers {}}} {

    # Generates a Obex `ABORT` request.
    #  headers - List of alternating header names and values.
    #
    # It is the caller's responsibility to ensure the value associated
    # with the header is formatted as described in [OBEX headers] and
    # that the supplied headers if valid for `ABORT` requests.
    # The `ConnectionId` header is automatically generated as needed
    # and should not be included by the caller.
    #
    # Returns a list of one or two elements, the first of which is either
    # `continue` or `failed`, and the second, if present, is data to be sent
    # to the server. See [input] for details.

    my BeginRequest abort
    set state(headers_out) [header encoden $headers]
    set packet [my OutgoingPacket 0xff 0]
    # Check if all headers were accomodated
    if {[llength $state(headers_out)]} {
        # Not all headers fit. Abort request must be a single packet
        my RaiseError "Headers too long for abort request."
    }
    return [list continue $packet]
}

method await {chan action_state} {

    # Synchronously completes an ongoing operation.
    #  chan - A Tcl channel for communicating with the server. This
    #    must not be multiplexed with other requests.
    #  action_state - The return value from a method that returns
    #    an action state such as [connect], [disconnect], [get],
    #    [put], [put_delete], [put_stream], [setpath], [abort] or [input].
    #
    # The method places the passed channel into binary blocking mode and
    # uses it to communicate with the server to complete all remaining
    # steps required for the operation to complete. The original modes are
    # restored before returning.
    #
    # Returns `done`, `writable` or `failed`. See [input]. Note the
    # method will not return `continue`.

    set chan_config [chan configure $chan]
    chan configure $chan -blocking 1 -buffering none  -translation binary
    try {
        return [my Await $chan $action_state]
    } finally {
        # Restore original config. Note -encoding and -eofchar
        # need explicitly set as -translation binary above
        # changes them but not changed back by -translation below.
        chan configure $chan  -blocking [dict get $chan_config -blocking]  -buffering [dict get $chan_config -buffering]  -encoding [dict get $chan_config -encoding]  -translation [dict get $chan_config -translation]  -eofchar [dict get $chan_config -eofchar]
    }
}

method clear {} {

    # Clears error state if any.
    #
    # The object is restored to an idle state readying it for another
    # request. The command will raise an error if called while a request
    # is in progress.
    my ResetRequest
    set state(state) IDLE
    return
}

method connect {{headers {}}} {

    # Generates a Obex connect request.
    #  headers - List of alternating header names and values.
    #
    # It is the caller's responsibility to ensure the value associated
    # with the header is formatted as described in [OBEX headers] and
    # that the supplied headers if any are acceptable in `connect` request.
    # The following headers are commonly used in connects:
    # `Target`, `Who`, `Count`, `Length` and `Description`.
    #
    # The method should not be called multiple times without an
    # intervening call to [disconnect].
    #
    # Returns a list of one or two elements, the first of which is either
    # `continue` or `failed`, and the second, if present, is data to be sent
    # to the server. See [input] for details.

    if {$state(connected)} {
        error "Already connected."
    }

    my BeginRequest connect
    set state(headers_out) [header encoden $headers]
    # Packet is opcode 0x80, 2 bytes length, version (1.0->0x10),
    # flags (0), 2 bytes max len (proposed)
    set extra [binary format cucuSu 0x10 0 65535]
    set packet [my OutgoingPacket 0x80 0 $extra]
    if {[llength $state(headers_out)]} {
        # Not all headers fit. Connect request must be a single packet
        my RaiseError "Headers too long for connect request."
    }
    return [list continue $packet]
}

method connected {} {

    # Returns 1 if the client has an OBEX connection active.
    return $state(connected)
}

method disconnect {{headers {}}} {

    # Generates a Obex disconnect request.
    #  headers - List of alternating header names and values.
    #
    # It is the caller's responsibility to ensure the value associated
    # with the header is formatted as described in [OBEX headers] and
    # that the supplied headers if valid for `disconnect` requests.
    # The `ConnectionId` header is automatically generated as needed
    # and shoould not be included by the caller.
    #
    # Returns a list of one or two elements, the first of which is either
    # `continue` or `failed`, and the second, if present, is data to be sent
    # to the server. See [input] for details.

    if {!$state(connected)} {
        error "Not connected."
    }
    my BeginRequest disconnect
    set state(headers_out) [header encoden $headers]
    set packet [my OutgoingPacket 0x81 0]
    # Check if all headers were accomodated
    if {[llength $state(headers_out)]} {
        # Not all headers fit. Disconnect request must be a single packet
        my RaiseError "Headers too long for disconnect request."
    }
    set state(connected) false
    return [list continue $packet]
}

method get {{headers {}}} {

    # Generates a Obex `GET` request.
    #  headers - List of alternating header names and values.
    #
    # It is the caller's responsibility to ensure the value associated
    # with the header is formatted as described in [OBEX headers] and
    # that the supplied headers if any are acceptable in `put` request.
    # The following headers are commonly used in put operations:
    # `Name`, `Type`, `Http`, `Timestamp` and `Description`.
    #
    # Returns a list of one or two elements, the first of which is either
    # `continue` or `failed`, and the second, if present, is data to be sent
    # to the server. See [input] for details.

    my BeginRequest get
    set state(headers_out) [header encoden $headers]
    return [list continue [my OutgoingPacket 0x03 0]]
}

method idle {} {

    # Returns 1 if another request can be issued, otherwise 0.
    return [expr {$state eq "IDLE"}]
}

method input {data} {

    # Process data from the remote server.
    #   data - Binary data as received from remote server.
    # The method takes as input data received from the server as part of
    # the response to a request. The return value from the method is a list
    # of one or two elements. The first element is one of the following:
    #   `done`       - The full response has been received. The application
    #                  can then call any of the retrieval methods or initiate
    #                  another request. If the second element is present and
    #                  and not empty, it is data to be sent to the server.
    #                  The application can call other methods to retrieve
    #                  the result of the request. The application may also
    #                  call methods to initiate the next request.
    #   `continue`   - The response has only been partially received. If
    #                  the second element is present and not empty, it is
    #                  data to be sent to the server. In either case, the
    #                  application should read more data from the server
    #                  and invoke the `input` method again passing it the
    #                  read data.
    #   `writable`   - This value is only returned if the current operation
    #                  was a streaming `put` operation initiated with
    #                  [put_stream]. It indicates that [put_stream] should
    #                  be called again to send the next chunk of data.
    #   `failed`     - The request failed. See [Request completion status]
    #                  for dealing with errors and failures. If
    #                  the second element is present and not empty, it is
    #                  data to be sent to the server. In either case, the
    #                  application must not invoke additional requests
    #                  without first calling the [reset] method.
    #
    # This method will raise an exception if no request is currently
    # outstanding.
    #
    # Returns a list of one or two elements, the first being one of
    # `done`, `failed`, `continue` or `writable` and the second optional
    # element being data to send to the server.

    my AssertState BUSY

    # Append new data to existing
    append state(input) $data

    if {! [response decode $state(input) $state(op) response]} {
        return continue;    # Incomplete packet, need more input
    }

    # TBD - should this be a protocol error if input was longer than packet
    # Possibly a response followed by an ABORT?
    set state(input) [string range $state(input) [dict get $response PacketLength] end]

    # If we have a connection id, the incoming one must match if present
    if {[info exists connection_id]} {
        if {![header find $response(Headers) ConnectionId conn_id] ||
            $connection_id != $conn_id} {
            # TBD - ignore mismatches for now
        }
    }

    # Save as latest response
    set state(response) $response

    # For multipart responses, collect headers
    lappend state(headers_in) {*}[dict get $response Headers]

    # Do request-specific processing
    return [switch -exact -- $state(op) {
        connect    { my ConnectResponseHandler }
        disconnect { my ResponseHandler false }
        put        { my ResponseHandler true }
        get        { my ResponseHandler true }
        setpath    { my ResponseHandler false }
        session    { error "Internal error: session request."}
        abort      { my ResponseHandler false }
        default {
            error "Unexpected request opcode $state(op)."
        }
    }]
}

method put {content {headers {}}} {

    # Generates a Obex `PUT` request.
    #  content - Content to be sent to server as-is. This must be formatted
    #   appropriately based on the `Type` header, `Http` or `ObjectClass`
    #   headers passed in. If none of these are present,
    #   the server may interpret $content in any
    #   manner it chooses, possibly looking at the `Name` header if present,
    #   some default handling or even rejecting the request.
    #  headers - List of alternating header names and values.
    #
    # It is the caller's responsibility to ensure the value associated
    # with the header is formatted as described in [OBEX headers] and
    # that the supplied headers if any are acceptable in `put` request.
    # The following headers are commonly used in put operations:
    # `Name`, `Type`, `Http`, `Timestamp` and `Description`.
    # The headers `Body`, `EndOfBody`, `Length` and `ConnectionId`
    # are automatically generated and should not be passed in.
    #
    # Returns a list of one or two elements, the first of which is either
    # `continue` or `failed`, and the second, if present, is data to be sent
    # to the server. See [input] for details.

    # TBD - maybe break up content into body headers assuming body space
    #  is packet size - packet header - connection id header. That would
    # simplify Put method

    my BeginRequest put
    lappend headers Length [string length $content] {*}[my SplitContent $content]
    set state(headers_out) [header encoden $headers]
    return [list continue [my OutgoingPacket 0x02 0]]
}

method put_delete {{headers {}}} {

    # Generates a Obex `PUT` request to delete an object.
    #  headers - List of alternating header names and values.
    #
    # It is the caller's responsibility to ensure the value associated
    # with the header is formatted as described in [OBEX headers] and
    # that the supplied headers if any are acceptable in `put` request.
    # The following headers are commonly used in put operations:
    # `Name`, `Type`, `Http`, `Timestamp` and `Description`.
    # The headers `Body`, `EndOfBody`, `Length` should not be present
    # in a delete operation and should not be passed in. Moreover,
    # `ConnectionId` header is automatically generated and should not
    # be passed in.
    #
    # Returns a list of one or two elements, the first of which is either
    # `continue` or `failed`, and the second, if present, is data to be sent
    # to the server. See [input] for details.

    my BeginRequest put
    set state(headers_out) [header encoden $headers]
    return [list continue [my OutgoingPacket 0x02 0]]
}

method put_stream {chunk {headers {}}} {

    # Generates a Obex `PUT` request with content provided in chunks.
    #  chunk - A content chunk to be sent. An empty string indicates end
    #   of the stream. This must be formatted
    #   appropriately based on the `Type` header, `Http` or `ObjectClass`
    #   headers passed in the initial call to `put_stream`.
    #   If none of these are present,
    #   the server may interpret content in any
    #   manner it chooses, possibly looking at the `Name` header if present,
    #   some default handling or even rejecting the request.
    #  headers - List of alternating header names and values. Should
    #   be empty on all calls except the first.
    #
    # This is similar to the [put] method except that it permits the
    # caller to present the data to be sent in chunks instead of all at
    # once. The application provides each chunk of the content in repeated
    # calls to `put_stream`.
    # This is more memory-efficient for large files. Only the first
    # call initiating the `PUT` operation may specify headers. Passing
    # an empty string indicates end of the content.
    #
    # Streaming operation is achieved through the following sequence of
    # calls:
    #
    #  * Streaming is initiated through a call to `put_stream` which
    #    normally returns `continue` with data to send to the server.
    #  * The [input] method is called with the response from the server.
    #    This returns `writable` indicating more data can be sent. The
    #    application then calls `put_stream` again with the next chunk.
    #  * This `input`, `put_stream` sequence is repeated until there
    #    is no more data to send at which time the application should
    #    call `put_stream` with an empty chunk.
    #
    # It is the caller's responsibility to ensure the value associated
    # with the header is formatted as described in [OBEX headers] and
    # that the supplied headers if any are acceptable in `put` request.
    # The following headers are commonly used in put operations:
    # `Name`, `Type`, `Http`, `Timestamp` and `Description`.
    # The headers `Body`, `EndOfBody`, and `ConnectionId`
    # are automatically generated and should not be passed in.
    # This method does not automatically add a `Length` header since
    # the length is not known a priori. However, some server implementations
    # require the `Length` header and therefore should be passed in
    # as part of $headers in such cases.
    #
    # Returns a list of one or two elements, the first of which is either
    # `continue` or `failed`, and the second, if present, is data to be sent
    # to the server. See [input] for details.
    if {$state(state) eq "IDLE"} {
        my BeginRequest put
    } else {
        my AssertState STREAMING
        if {[llength $headers] != 0} {
            my RaiseError "Headers only allowed in first chunk of a data stream."
        }
    }
    if {[string length $chunk] != 0} {
        # Note no Length header as unknown!
        lappend headers {*}[my SplitContent $chunk]
        set state(streaming) 1
    } else {
        lappend headers EndOfBody {}
        set state(streaming) 0
        # TBD - do we need to guard against more put_stream calls
        # after EndOfBody is sent?
    }
    set state(headers_out) [header encoden $headers]
    set state(state) BUSY
    return [list continue [my OutgoingPacket 0x02 0]]
}

method reset {} {

    # Resets state of the object.
    #
    # The object is placed in the same state as when it was newly constructed.
    # All state information is lost.

    # Connection specific state
    set state(state)  IDLE
    set state(connected) false
    unset -nocomplain state(connection_id)
    unset -nocomplain state(connection_header)
    unset -nocomplain state(target)
    unset -nocomplain state(who)
    set state(max_packet_len) 255; # Assume min unless remote tells otherwise

    # Request specific state
    my ResetRequest
}

method response {} {

    # Returns the last response received from the server.
    #
    # The return value is a dictionary in the same form as returned by
    # the [::obex::core::response decode] command.
    return $state(response)
}

method session {{headers {}}} {

    # Generate a OBEX `session` request.
    #  headers   - List of alternating header names and values.
    # This command is not implemented.
    error "Sessions not implemented in this release."
}

method setpath {{headers {}} args} {

    # Generates a Obex `SETPATH` request.
    #  headers   - List of alternating header names and values.
    #  -parent   - Apply operation at the parent's level.
    #  -nocreate - Do no create folder if it does not exist.
    #
    # It is the caller's responsibility to ensure the value associated
    # with the header is formatted as described in [OBEX headers] and
    # that the supplied headers if valid for `SETPATH` requests.
    # The `ConnectionId` header is automatically generated as needed
    # and shoould not be included by the caller.
    #
    # Returns a list of one or two elements, the first of which is either
    # `continue` or `failed`, and the second, if present, is data to be sent
    # to the server. See [input] for details.

    my BeginRequest setpath

    set flags 0
    set constants 0
    foreach opt $args {
        switch -exact -- $opt {
            -parent { set flags [expr {$flags | 1}] }
            -nocreate { set flags [expr {$flags | 2}] }
            default {
                error "Unknown option \"$opt\"."
            }
        }
    }

    set state(headers_out) [header encoden $headers]
    set packet [my OutgoingPacket 0x85 0 [binary format cucu $flags $constants]]
    if {[llength $state(headers_out)]} {
        # Not all headers fit. setpath request must be a single packet
        my RaiseError "Headers too long for setpath request."
    }
    return [list continue $packet]
}

method state {} {

    # Returns the state of the client.
    #
    # The returned state is in the form of a dictionary with the following
    # elements:
    #   State - Client state; one of `IDLE`, `BUSY` or `ERROR`
    #   Connected - 0/1 depending on whether connected or not.
    #   ConnectionId - The connection id. Only present if connected
    #                  **and** remote server sent a connection id.
    #   MaxPacketLength - Maximum packet length negotiated.
    #   ErrorMessage - If present, the last error seen.

    set l [list State $state(state)  Connected $state(connected)  MaxPacketLength $state(max_packet_len)]

    if {[info exists state(connection_id)]} {
        lappend l ConnectionId $state(connection_id)
    }
    if {[info exists state(error_message)]} {
        lappend l ErrorMessage $state(error_message)
    }

    return $l
}

method status {} {

    # Returns the status of the last response received.
    #
    # The returned value is one of
    # `success`, `informational`, `redirect`,
    # `clienterror`, `servererror`, `databaseerror` or `protocolerror`.
    # See [::obex::Request completion status].
    #
    # The command will raise an error if no response has been received
    # for any request.
    return [dict get $state(response) ResponseStatus]
}

method status_detail {} {

    # Returns the detailed status of the last response received.
    #
    # The returned dictionary has the following keys:
    #  ResponseStatus   - The generic status category.
    #  ResponseCode     - The numeric response code from server.
    #  ResponseCodeName - Mnemonic form of `ResponseCode`
    #  ErrorMessage     - Additional human readable error status message. This
    #                     key may not be present.
    #
    # For more information on values for the above keys, see
    # [::obex::Request completion status].
    #
    # The command will raise an error if no response has been received
    # for any request.
    dict with state(response) {
        lappend status ResponseStatus $ResponseStatus  ResponseCode $ResponseCode  ResponseCodeName [response::ResponseCodeName $ResponseCode]
        if {[info exists state(error_message)]} {
            lappend status ErrorMessage $state(error_message)
        }
    }
    return $status
}

method bodies {} {

    # Get the data content in a request or response
    #
    # The data content is transferred in Obex through headers of type `Body`
    # and `EndOfBody`. This method returns the values received through these
    # headers as a list. The content is in binary form and needs to be
    # appropriately interpreted depending on the application specifics. Note
    # the content may be fragmented at arbitrary boundaries during
    # transmission and so the returned values may need to be concatenated
    # before operations like UTF-8 decoding.
    #
    # Returns list of binary strings received through `Body` and `EndOfBody`
    # headers.

    set bodies {}
    foreach {name val} $state(headers_in) {
        if {$name in {Body EndOfBody}} {
            lappend bodies $val
        }
    }
    return $bodies
}

method headers {name} {

    # Retrieves the content of headers of a given type.
    #  name - name of the header
    # Returns a list each element of which is the value of a header
    #
    return [header findall $state(headers_in)]
}

method constructor {args} {

    namespace path [linsert [namespace path] end ::obex ::obex::core]
    my reset
    if {[llength [self next]]} {
        next {*}$args
    }
}

method get_request {} {

    return $state(request)
}

method input {data} {

    # Process data received from a client.
    #   data - Binary data as received from client.
    # The method takes as input data received from a client.
    # The return value from the method is a list of one or two
    # of one or two elements. The first element is one of `done`
    # `continue` or `failed`. The semantics depend on whether
    # the request is in the **request** phase or the **response**
    # phase.
    #
    # In the **request** phase,
    #   `done`  - The request was completed without need for an explicit
    #            response from the application. If the
    #            the second element is present and not empty, it is data
    #            to be sent to the client.
    #   `respond` - The full request has been received. The application should
    #            then call one of the response methods to reply to the client. If
    #            the second element is present and not empty, it is data
    #            to be sent to the client. The application can call other
    #            methods to retrieve the request.
    #   `continue` - The request has only been partially received. If the
    #            second element is present and not empty, it is data to be
    #            sent to the client. In either case, the application should
    #            read more data from the client and again invoke the [input]
    #            method passing it the read data.
    #   `failed` - The request has failed. See [Request completion status] for dealing
    #            with errors and failures. If the second element is present
    #            and not empty, it is data to be sent to the client. In
    #            either case, the application must not use this instance
    #            to accept additional requests without first calling the
    #            [reset] method.
    #
    # In the **response** phase,
    #   `done` - The full response has been sent to the client.
    #            If the second element is present and not empty, it is data
    #            to be sent to the client. The application can then
    #            process a new request using this object.
    #   `continue` - The response has only been partially sent. If the
    #            second element is present and not empty, it is data to be
    #            sent to the client. In either case, the application should
    #            read more data from the client and invoke the [input] method
    #            again passing it the read data.
    #   `failed` - The request has failed. See [Request completion status] for dealing
    #            with errors and failures. If the second element is present
    #            and not empty, it is data to be sent to the client. In
    #            either case, the application must not use this instance
    #            to accept additional requests without first calling the
    #            [reset] method.
    #

    switch -exact -- $state(state) {
        IDLE -
        REQUEST { my RequestPhaseInput $data}
        RESPOND { my ResponsePhaseInput $data}
        ERROR   { error "Method must not be called after an error without calling the reset method first."}
        default { error "Internal error: unknown state $state(state)"}
    }
}

method reset {} {

    # Resets state of the object.
    #
    # The object is placed in the same state as when it was newly constructed.
    # All state information is lost.

    # Connection specific state
    set state(state)  IDLE
    unset -nocomplain state(connection_id); # Set when connect comes in
    unset -nocomplain state(connection_header)
    set state(max_packet_len) 255; # Assume min until remote tells otherwise

    # Request specific state
    my ResetRequest
}

method respond {status {headers {}}} {

    my AssertState RESPOND

    set state(headers_out) [header encoden $headers]
    set status [response::ResponseCode $status]
    set state(response_code) $status

    # CONNECT and DISCONNECT need special handling.
    set op [dict get $state(request) OpName]
    if {$op eq "connect"} {
        set state(max_packet_len) [dict get $state(request) MaxLength]
        set state(connection_id) [GenerateId]
        set state(connection_header)  [header encode ConnectionId $state(connection_id)]
        set state(headers_out) $headers
        # Packet is opcode 0x80, 2 bytes length, version (1.0->0x10),
        # flags (0), 2 bytes max len
        set extra_fields [binary format cucuSu 0x10 0 $state(max_packet_len)]
    } elseif {$op eq "disconnect"} {
        set extra_fields ""
        unset -nocomplain state(connection_id)
        unset -nocomplain state(connection_header)
        set state(max_packet_len) 255
    } else {
        set extra_fields ""
    }

    # TBD - assume a single packet response
    set status [expr {$status | 0x80}]
    set packet [my OutgoingPacket $status 1 $extra_fields]
    if {[llength $state(headers_out)]} {
        # TBD - don't know exactly how multipacket responses work when
        # status is not continue.
        my RaiseError "Response does not fit in a packet."
    }
    return [list done $packet]
}

method respond_content {content {headers {}}} {

    # Generate a response containing content.
    #  content - content to include in the response to the client.
    #  headers - List of alternating header names and values.
    #
    my AssertState RESPOND
    lappend headers Length [string length $content] {*}[my SplitContent $content]
    set state(headers_out) [header encoden $headers]
    set state(response_code) $status
    set packet [my OutgoingPacket $state(response_code) 1]
    if {[llength $state(headers_out)]} {
        return [list continue $packet]
    } else {
        return [list done $packet]
    }
}

method state {} {

    # Returns the state of the server.
    #
    # The returned state is in the form of a dictionary with the following
    # elements:
    #   State - Server state; one of `IDLE`, `REQUEST`, `RESPOND` or `ERROR`
    #   Connected - 0/1 depending on whether connected or not.
    #   ConnectionId - The connection id. Only present if connected.
    #   MaxPacketLength - Maximum packet length negotiated.
    #   ErrorMessage - If present, the last error seen.

    set l [list State $state(state)  MaxPacketLength $state(max_packet_len)]
    if {[info exists state(connection_id)]} {
        lappend l Connected 1 ConnectionId $state(connection_id)
    } else {
        lappend l Connected 0
    }
    if {[info exists state(error_message)]} {
        lappend l ErrorMessage $state(error_message)
    }
    return $l
}