::obex::coreTop, Main, Index

proc ::obex::core::header::decode {bytes start} {

    # Decodes a single binary OBEX header within a packet.
    #  bytes - Binary string containing a header.
    #  start - Offset into $bytes where the header starts.
    # Returns a pair consisting of the [header name][OBEX headers]
    # and value.
    return [lrange [DecodeFirst $bytes $start] 0 1]
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::header::decoden {bytes start} {

    # Decodes binary OBEX headers within a packet.
    #  bytes - Binary string containing headers.
    #  start - Offset into $bytes where the headers start.
    # Returns a list of headers as dictionaries with
    # [header names][OBEX headers] as keys.
    set nbytes [string length $bytes]
    set headers {}
    while {$start < $nbytes} {
        lassign [DecodeFirst $bytes $start] name value start
        lappend headers $name $value
    }
    return $headers
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::header::encode {header_name header_value} {

    # Encodes a single OBEX header.
    #  header_name - The [header identifier][::obex::OBEX headers] name.
    #  header_value - The value to encode. For binary header types, it is
    #    caller's responsibility to pass this as a proper binary string.
    #
    # Returns the encoded header binary string.
    set hi [Id $header_name]
    # Top 2 bits encode data type
    switch -exact -- [expr {$hi >> 6}] {
        0 {
            # Encode as big-endian unicode
            set unicode_be [ToUnicodeBE $header_value]
            # Add a length field where the length includes 3 bytes for Header byte
            # and 2 bytes for length, and the 2 bytes for terminating Unicode null.
            set hlen [expr {3+[string length $unicode_be]+2}]
            append encoded [binary format cS $hi $hlen] $unicode_be "\0\0"
            return $encoded
        }
        1 {
            # Just an array of bytes. Caller has to ensure that is what it  is.
            set hlen [expr {3 + [string length $header_value]}]
            append encoded [binary format cS $hi $hlen] $header_value
            return $encoded
        }
        2 {
            # Single byte. Always room since space_left check at top
            return [binary format cc $hi $header_value]
        }
        3 {
            # Big endian 4 bytes
            return [binary format cI $hi $header_value]
        }
    }
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::header::encoden {args} {

    # Encodes multiple OBEX headers.
    #  args - Alternating list of [header names][OBEX headers] and values.
    #    This may also be provided as a single argument of the same form.
    #    For binary header types, it is
    #    caller's responsibility to pass the values as a proper binary string.
    #
    # Returns the encoded headers as a list of binary strings.
    if {[llength $args] == 1} {
        set args [lindex $args 0]
    }
    set headers {}
    foreach {name value} $args {
        lappend headers [encode $name $value]
    }
    return $headers
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::header::find {headers header_name outvar} {

    # Gets the value of a header from a list of decoded OBEX headers.
    #  headers - list of decoded OBEX headers.
    #  header_name - [Header name][OBEX headers] to retrieve.
    #  outvar - Name of variable in caller's context where to store
    #   the header value.
    # If multiple headers of the same name exist, returns the value of
    # the first in the list.
    #
    # Returns 1 if the header is found and stores its value in $outvar;
    # otherwise returns 0.
    foreach {name val} $headers {
        if {[string equal -nocase $header_name $name]} {
            upvar 1 $outvar v
            set v $val
            return 1
        }
    }
    return 0
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::header::findall {headers header_name} {

    # Gets the values of headers with a given name in list of
    # decoded OBEX headers
    #  headers - list of decoded OBEX headers.
    #  header_name - [Header name][OBEX headers] to retrieve.
    # Returns the list of values from headers that matched $header_name.
    return [lmap {name val} $headers {
        if {![string equal -nocase $header_name $name]} {
            continue
        }
        set val
    }]
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::packet::complete {packet} {

    # Returns 1 if $packet is a complete Obex packet and 0 otherwise.
    #  packet - an OBEX packet or fragment.
    if {[binary scan $packet xSu -> len] != 1} {
        return 0
    }
    return [expr {$len <= [string length $packet]}]
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::packet::length {packet} {

    # Get the length of a packet.
    #  packet - an OBEX packet or the initial fragment of one with
    #           at least three bytes.
    # Returns the packet length as encoded in its header or 0 if the passed
    # fragment is too short to contain a length field.

    if {[binary scan $packet xSu len] != 1} {
        return 0
    }
    return $len
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::parameters::decode {bytes} {

    # Decodes a [AppParameters][OBEX headers] header value.
    #  bytes - binary containing the header value
    # Returns a list of containg the integer application parameter
    # tag alternating with the corresponding binary string value.
    set nbytes [string length $bytes]
    set params {}
    set start 0
    while {$start < $nbytes} {
        lassign [DecodeFirst $bytes $start] tag value start
        lappend params $tag $value
    }
    return $params
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::request::decode {packet outvar} {

    # Decodes an OBEX request packet received from a client.
    #  packet - Binary OBEX packet.
    #  outvar - name of variable in caller's context where the decoded packet
    #    is to be stored.
    #
    # If $packet contains a complete OBEX packet, the command stores the
    # decoded packet in the variable names $outvar in the caller's context.
    # The value is in the form of a dictionary with the following keys:
    #  PacketLength - Length of packet.
    #  OpCode       - Numeric request opcode.
    #  OpName       - Mnemonic opcode name.
    #
    #  Final        - 1/0 depending on whether the `final` bit was set
    #                 in the request opcode or not.
    #  Headers      - List of headers received in the packet.
    #
    # In case the packet was a `connect` request, the dictionary also
    # contains the following keys:
    #  Flags        - Always 0 for OBEX 1.0
    #  MaxLength    - Maximum length OBEX packet length the server can
    #                 receive.
    #  MajorVersion - The OBEX protocol major version returned by server.
    #  MinorVersion - The OBEX protocol minor version returned by server.
    #
    # In case the packet was a `setpath` request, the dictionary also
    # contains the following keys:
    #  Flags        - The flags field from the request.
    #  Constants    - The constants field from the request.
    #
    # Returns 1 if the packet was decoded or 0 if it is incomplete.
    upvar 1 $outvar decoded_packet
    if {[binary scan $packet cuSu op len] != 2 ||
        $len > [string length $packet]} {
        return 0
    }
    if {$op == 0x80} {
        # CONNECT request
        # Packet is opcode 0x80, 2 bytes length, version (1.0->0x10),
        # flags (0), 2 bytes max len followed by headers
        if {[binary scan $packet x3cucuSu version flags maxlen] != 3} {
            return 0
        }
        set decoded_packet [list  PacketLength $len  OpCode $op  Final  [expr {($op & 0x80) == 0x80}]  OpName [OpName $op]  MajorVersion [expr {$version >> 4}]  MinorVersion [expr {$version & 0xf}]  Flags  $flags  MaxLength $maxlen  Headers [header decoden $packet 7]  ]
    } elseif {$op == 0x87} {
        # SETPATH request
        if {[binary scan $packet x3cucu flags constants] != 2} {
            return 0
        }
        set decoded_packet [list  PacketLength $len  OpCode $op  Final  [expr {($op & 0x80) == 0x80}]  OpName [OpName $op]  Flags  $flags  Constants $constants  Headers [header decoden $packet 5]  ]
    } else {
        set decoded_packet [list  PacketLength $len  OpCode $op  OpName [OpName $op]  Final  [expr {($op & 0x80) == 0x80}]  Headers [header decoden $packet 3]  ]
    }
    return 1
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::request::encode {op args} {

    # Encodes an OBEX request.
    #  op - A numeric request opcode or a opcode [mnemonic][OBEX operations].
    #  args - Alternating list of [header names][OBEX headers] and values.
    #    This may also be provided as a single argument of the same form.
    # Encodes a OBEX packet containing the specified opcode and headers.
    # No length checks are made and caller is responsible for ensuring the
    # generated packet length does not exceed the maximum packet size
    # for the OBEX connection.
    #
    # Returns the encoded packet.
    set op [OpCode $op]
    if {$op == 0x80} {
        return [EncodeConnect {*}$args]
    } elseif {$op == 0x87} {
        return [encode_setpath 0 0 {*}$args]
    }
    # Generic request encoder
    set headers [join [header encoden {*}$args] ""]
    # Packet is opcode, 2 bytes length, followed by headers
    set len [expr {3+[string length $headers]}]
    append packet [binary format cSu $op $len] $headers
    return $packet
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::request::encode_setpath {flags constants args} {

    # Encodes a `setpath` OBEX request.
    #  flags - Numeric value to send for the flags field in the `setpath`
    #    request.
    #  constants - Numeric value to send for the constants field in the request
    #  args - Alternating list of [header names][OBEX headers] and values.
    #    This may also be provided as a single argument of the same form.
    # This command can be used in lieu of the [request encode] command when the
    # `setpath` request needs to include values for the `flags` or `constants`
    # fields.
    #
    # No length checks are made and caller is responsible for ensuring the
    # generated packet length does not exceed the maximum packet size
    # for the OBEX connection.
    #
    # Returns an encoded OBEX `setpath` request packet.

    set headers [join [header encoden {*}$args] ""]
    # Packet is opcode 0x85, 2 bytes length,
    # flags, constants, # followed by headers
    set len [expr {5+[string length $headers]}]
    append packet [binary format cuSucucu 0x85 $len flags constants] $headers
    return $packet
}
# NOTE: showing source of procedure implementing ensemble subcommand.

proc ::obex::core::response::decode {packet request_op outvar} {

    # Decodes a response packet.
    #  packet - Binary OBEX packet.
    #  request_op - The request opcode corresponding to this response.
    #  outvar - name of variable in caller's context where the decoded packet
    #    is to be stored.
    #
    # The dictionary stored in $outvar has the following keys:
    #  PacketLength       - Length of packet.
    #  Final        - 1/0 depending on whether the `final` bit was set
    #                 in the response operation code or not.
    #  Headers      - List of headers received in the packet.
    #  ResponseStatus       - The general status category.
    #  ResponseCode   - The numeric response status code from server.
    #
    # In case the response was for a `connect` request, the dictionary also
    # contains the following keys:
    #  Flags        - As returned by serve. Always 0 for OBEX 1.0
    #  MaxLength    - Maximum length OBEX packet length the server can
    #                 receive.
    #  MajorVersion - The OBEX protocol major version returned by server.
    #  MinorVersion - The OBEX protocol minor version returned by server.
    #
    # Returns 1 if the packet was decoded or 0 if it is incomplete.

    # TBD - do we need to check for ABORT packet as well?

    if {[binary scan $packet cuSu status len] != 2 ||
        $len > [string length $packet]} {
        return 0
    }

    upvar 1 $outvar decoded_packet

    set request_op [request::OpCode $request_op]
    if {$request_op == 0x80} {
        return [DecodeConnect $packet decoded_packet]
    }

    set decoded_packet [list  PacketLength     $len  ResponseCode $status  ResponseStatus   [ResponseStatus $status]  Final      [expr {($status & 0x80) == 0x80}]  Headers    [header decoden $packet 3]  ]
    return 1
}
# NOTE: showing source of procedure implementing ensemble subcommand.