Redge Shepherd
TclTk Scripts

TclTk Scripts

MQTT, Broker, and Tcl

MQTT, Broker, and Tcl

Redge Shepherd's photo
Redge Shepherd
·Dec 7, 2021·

11 min read

Subscribe to my newsletter and never miss my upcoming articles

Table of contents

  • MQTT - Message Queuing Telemetry Transport
  • MQTT and Tcl
  • The Code

MQTT - Message Queuing Telemetry Transport

Curiosity often leads to unforeseeable tangents. MQTT, the messaging and data exchange protocol of the IoT, caught my attention. MQTT was first invented in 1999 and gave rise to the current wave of IoT. I'm always intrigued by the "problems" that drive innovation, especially in the realm of software.

MQTT and Tcl

The MagicSplat distribution of Tcl 8.6.12 includes mqtt (3.1) and broker (2.1). The MQTT package adds the client-side of the MQTT protocol to an application while the broker package provides resources for implementing an MQTT server.

For more information on the mqtt and broker packages visit mqtt: MQTT Client and broker: MQTT Server.

Note: Your browser or malware/antivirus software may reject the SSL or even suggest the presence of a Trojan while attempting to reach the chiselapp.com web pages referenced above. I had no problems when loading the site using Safari on my Apple devices. However, I had to change permissions in Malwarebytes to allow the site to load on my Windows machines.

The broker uses an SQLite3 database consisting of the following tables and their respective columns.

  1. account: username, password
  2. client: clientid, client, allowed
  3. config: name, value
  4. filter: clientid, pattern, options, subid, pool
  5. message: msguid, topic, content, time, flags, pending, clientid
  6. properties: msguid, name, value
  7. session: clientid, msgid, interval, expire, msguid, delay
  8. state: clientid, msguid, qos, retain, subids, identifier, stage

Triggers:

  1. message_clean
  2. session_delete
  3. state_delete
  4. state_insert

The Code

The preliminary "Sandbox" code appears below and is understandably a work in progress.

# References
# https://chiselapp.com/user/schelte/repository/mqtt/wiki?name=Tcl+MQTT+server
# https://chiselapp.com/user/schelte/repository/mqtt/wiki?name=Tcl+MQTT+client

package require Tcl     ;# 8.6.12
package require Tk      ;# 8.6.12
package require mqtt    ;# 3.1
package require broker  ;# 2.1
package require sqlite3 ;# 3.36.0

set startTime [clock seconds]
# set CopyrightDate [clock format $startTime -format "%a (%j) %y-%m-%d-%H:%M:%S"]

set CopyrightDate [clock format $startTime -gmt 1 -format "(%u) %a (%j) %Y-%m-%d-%T %Z"]
puts "%C startTime = [clock format $startTime -format %c]"

puts "%U startTime = [clock format $startTime -format %U]"
puts "%V startTime = [clock format $startTime -format %V]"
puts "%W startTime = [clock format $startTime -format %W]"

puts "Welcome to the MQTT - Client/Broker Manager"

# ***************************************************************************
proc ClientConnect { client topic } {
    global mqttBroker
    #global Client01

    upvar #0 $client connectClient
    upvar #0 $client connectTopic

    puts "Working on ClientConnect"
    puts "Parameter client = $client"
    puts "connectClient = $connectClient"
    puts "Executing initial code segment"

    # set cnxnClient [mqtt create $::Client01 -clean off -protocol 4]
    if { [catch {mqtt create $connectClient -clean off -protocol 4} fid] } {
        puts "Returned Code:  $fid"
        puts "Already Connected to $::mqttBroker"
    } else {
        puts "Returned Code:  $fid"
        puts "Check Configuration for $connectClient"
        puts "$connectClient Connected - configuration:  [$connectClient configure]"
        $connectClient connect $::mqttBroker localhost 1883
    }
}

proc ClientSubscribe { client topic } {
    puts "Client Subscribe"
    # Are we connected to a broker?
    upvar #0 $client subscribeClient
    upvar #0 $topic subscribeTopic

    puts "Parameter client = $client"
    puts "subscribeClient = $subscribeClient"
    puts "Executing initial code segment"

    if { [catch {$subscribeClient subscribe $subscribeTopic putCLIENTmsgs} errmsg] } {
        puts "Subscribe ERROR - ClientSubscribe ELSE Returned Code:  $errmsg"
    } else {
        puts "ClientSubscribe Returned Code:  $errmsg"
        puts "Connected to $::mqttBroker"
        puts "Subscribed to topicA"
    }
}

# arguments:  client, topic, payload
proc ClientPublish { client topic payload } {
    puts "Client Publish"

    upvar #0 $client publishClient
    upvar #0 $topic publishTopic
    upvar #0 $payload publishPayLoad

    puts "Parameter client = $client"
    puts "publishClient = $publishClient"
    puts "Executing initial code segment"

    incr ::topicAcount
    set publishMessage "Message $::topicAcount > $publishPayLoad"

    if { [catch {$publishClient publish $publishTopic $publishMessage} errmsg] } {
        puts "Publish ERROR - ClientSubscribe ELSE Returned Code:  $errmsg"
    } else {
        puts "ClientPublish Returned Code:  $errmsg"
        .publishFrame.publishMsgs insert end "$publishMessage\n"
        .publishFrame.publishMsgs see end-2c
        puts "Published to $publishTopic:  $publishMessage"
    }
}

proc ClientDisconnect { client topic } {
    #global client01
    puts "Client Disconnect"

    upvar #0 $client disconnectClient
    upvar #0 $topic disconnectTopic

    puts "Parameter client = $client"
    puts "disconnectClient = $disconnectClient"
    puts "Executing initial code segment"
    set disconnectMessage "Session Terminated $::topicAcount"

    if { [catch {$disconnectClient disconnect} errmsg] } {
        puts "Disconnect Error - ClientSubscribe ELSE Returned Code:  $errmsg"
    } else {
        puts "ClientDisconnect Returned Code:  $errmsg"
        .publishFrame.publishMsgs insert end "$disconnectMessage\n"
        .publishFrame.publishMsgs see end-2c
        putCLIENTmsgs "Session Terminated - Client Disconnected"
    }
}

proc putBrokerLog { args } {
    .brkrFrame.brkrMsgs insert end "$args\n"
    .brkrFrame.brkrMsgs see end-2c
}

proc putMQTTmsgs { args } {
    .mqttFrame.mqttMsgs insert end "$args\n"
    .mqttFrame.mqttMsgs see end-2c
}

proc putCLIENTmsgs { args } {
    .clientFrame.clientMsgs insert end "$args\n"
    .clientFrame.clientMsgs see end-2c
}

proc textLabelFrame {framePrefix title width height wrap} {
    set newframe ${framePrefix}Frame
    set newmsgs ${framePrefix}Msgs

    labelframe .$newframe -text $title
    text .$newframe.$newmsgs -width $width -height $height -background black -foreground yellow \
                         -wrap $wrap -yscrollcommand ".$newframe.ys set" -xscrollcommand ".$newframe.xs set"
    ttk::scrollbar .$newframe.ys -orient vertical -command ".newframe.$newmsgs yview"
    ttk::scrollbar .$newframe.xs -orient horizontal -command ".$newframe.$newmsgs xview"
    grid .$newframe.$newmsgs -column 0 -row 0 -sticky nwes
    grid .$newframe.xs -column 0 -row 1 -sticky we
    grid .$newframe.ys -column 1 -row 0 -sticky ns
    grid columnconfigure .$newframe 0 -weight 1
    grid rowconfigure .$newframe 0 -weight 1
    return .$newframe
}

# Verify Entries
# VERIFY the username and password combination against the database.
proc verifyEntry {} {
    global signIn

    puts "Entered verifyEntry procedure."
    puts "String $::signIn(username)\nLength:  [string length $::signIn(username)]"
    puts "String $::signIn(password)\nLength:  [string length $::signIn(password)]"

    if { [string length $::signIn(username)] > 0 && [string length $::signIn(password)] > 0} {
        puts "Entry verfied"
        set ::signIn(ok) 1
    } else {
        # Do NOT set signIn(ok) to 0
        # tkwait interprets a set as equivalent to a "change"
        puts "Entry error:  Zero length entries.\nSignIn(ok) = $::signIn(ok)"
    }
    puts "Exiting veryEntry procedure."
}

proc validateEntry {statusLabel action charindex newentry oldentry validationtype validationtrigger widgetname} {
    # validateEntry %d %i %P %s %v %V %W
    # Entry and spinbox validation substitutions
    # Reference page 509, Chapter 34.
    set validstate 0
    puts "statusLabel $statusLabel"
    puts "Entered proc validateEntry called by $widgetname (%W)"
    puts "%d $action (Type of action that triggered validation (1=insert, 0=delete, -1 focus forced or textvariable)"
    puts "%i $charindex (Index of the character string to be inserted or deleted)"
    puts "%P $newentry (the value of the widget should the change occur)"
    puts "%s $oldentry (the value of the widget before the proposed change)"
    puts "%v $validationtype (current value of the validate attribute)"
    puts "%V $validationtrigger (type of validation that triggered the callback (key, focusin, focusout, forced)"
    puts "%W widgetname (name of the widget that triggered the validation"

    if {[string length $newentry] > 0} {
        puts "statusLabel $statusLabel"
        $statusLabel config -text "Entry Validated"
        set validstate 1

    } else {
        $statusLabel config -text "Invalid Entry"
        set validstate 0
    }

    # Changing a widget's value during validation disables future validation
    # Precautionary reset to original validation type
    after idle [list $widgetname configure -validate $validationtype]

    puts "Exiting proc validateEntry - state:  $validstate"
    #focus $widgetname
    return $validstate
}

proc invalidEntry {statusLabel action charindex newentry oldentry validationtype validationtrigger widgetname} {
    puts "Entering proc invalidEntry"
    puts "statusLabel $statusLabel"
    $statusLabel config -text "Invalid Entry"
    puts "The validateEntry procedure returned a FALSE value."
    puts "$action, $charindex, $newentry, $oldentry, $validationtype, $validationtrigger, $widgetname"
    # puts "%d $action (Type of action that triggered validation (1=insert, 0=delete, -1 focus forced or textvariable)"
    # puts "%i $charindex (Index of the character string to be inserted or deleted)"
    # puts "%P $newentry (the value of the widget should the change occur)"
    # puts "%s $oldentry (the value of the widget before the proposed change)"
    # puts "%v $validationtype (current value of the validate attribute)"
    # puts "%V $validationtrigger (type of validation that triggered the callback (key, focusin, focusout, forced)"
    # puts "%W widgetname (name of the widget that triggered the validation"

    # Changing a widget's value during validation disables future validation
    # Precautionary reset to original validation type
    after idle [list $widgetname configure -validate $validationtype]
    puts "Exiting proc invalidEntry"
    return 1
}

# ***************************************************************************
# Main Window - Welcome

frame .headerFrame
label .headerFrame.lblWelcome -text "Welcome to TclTkScripts.com - MQTT Client/Broker Sandbox"
pack .headerFrame.lblWelcome -side top -expand no -fill x
# ***************************************************************************

# create the framed text boxes
# create brkrFrame
textLabelFrame brkr {Broker/Server Log} 40 10 none
# create mqttFrame
textLabelFrame mqtt {MQTT Message Center} 40 10 none
# create clientFrame
textLabelFrame client {Client Subscription Messages} 40 10 none
# create publishFrame
textLabelFrame publish {Client Published Messages} 40 10 none

# ***************************************************************************
set ::ClientID(ok) 0
set ::ClientID(ID) 0
set ::ClientID(connected) 0
set ::ClientID(username) "Redge"
set ::ClientID(password) ""
set ::ClientID(topic) "Topic A"
set ::ClientID(payload) "This is the Payload"
set ::ClientID(result) ""

frame .newUser

labelframe .newUser.newClient -text "Username"
set validateUser "Enter Valid Username"
label .newUser.newClient.lblClientHelp -text $validateUser
label .newUser.newClient.lblClientId -text "Client Id:"
entry .newUser.newClient.entClientId -background black -foreground yellow -textvariable ::ClientID(username) \
                -validate all -vcmd [list validateEntry .newUser.newClient.lblClientHelp %d %i %P %s %v %V %W] \
                -invalidcommand [list invalidEntry .newUser.newClient.lblClientHelp %d %i %P %s %v %V %W]
# always show or display last characters being entered on the screen.
.newUser.newClient.entClientId xview moveto 1.0

grid .newUser.newClient.lblClientId -row 0 -column 0 -padx 5 -pady 4
grid .newUser.newClient.entClientId -row 0 -column 1 -padx 5 -pady 4
grid .newUser.newClient.lblClientHelp -row 1 -column 1 -columnspan 2

labelframe .newUser.newPassword -text "Password"
set validatePassword "Enter Valid Password"
label .newUser.newPassword.lblPasswordHelp -text $validatePassword
label .newUser.newPassword.lblPassword -text "Password:"
entry .newUser.newPassword.entPassword -show "*" -background black -foreground yellow -textvariable ::ClientID(password) \
                -validate all -validatecommand [list validateEntry .newUser.newPassword.lblPasswordHelp %d %i %P %s %v %V %W] \
                -invalidcommand [list invalidEntry .newUser.newPassword.lblPasswordHelp %d %i %P %s %v %V %W]
# always show or display last characters being entered on the screen.
.newUser.newPassword.entPassword xview moveto 1.0

grid .newUser.newPassword.lblPassword -row 0 -column 0 -padx 5 -pady 4
grid .newUser.newPassword.entPassword -row 0 -column 1 -padx 5 -pady 4
grid .newUser.newPassword.lblPasswordHelp -row 1 -column 1 -columnspan 2

labelframe .newUser.newTopic -text "Topic"
set validateTopic "Enter Valid Topic"
label .newUser.newTopic.lblTopicHelp -text $validateTopic
label .newUser.newTopic.lblTopic -text "Topic:"
entry .newUser.newTopic.entTopic -background black -foreground yellow -textvariable ::ClientID(topic) \
                -validate all -validatecommand [list validateEntry .newUser.newTopic.lblTopicHelp %d %i %P %s %v %V %W] \
                -invalidcommand [list invalidEntry .newUser.newTopic.lblTopicHelp %d %i %P %s %v %V %W]
# always show or display last characters being entered on the screen.
.newUser.newTopic.entTopic xview moveto 1.0

grid .newUser.newTopic.lblTopic -row 0 -column 0 -padx 5 -pady 4
grid .newUser.newTopic.entTopic -row 0 -column 1 -padx 5 -pady 4
grid .newUser.newTopic.lblTopicHelp -row 1 -column 1 -columnspan 2

labelframe .newUser.newPayLoad -text "PayLoad"
set validatePayLoad "Enter Valid PayLoad"
label .newUser.newPayLoad.lblPayLoadHelp -text $validatePayLoad
label .newUser.newPayLoad.lblPayLoad -text "PayLoad:"
entry .newUser.newPayLoad.entPayLoad -background black -foreground yellow -textvariable ::ClientID(payload) \
                -validate all -validatecommand [list validateEntry .newUser.newPayLoad.lblPayLoadHelp %d %i %P %s %v %V %W] \
                -invalidcommand [list invalidEntry .newUser.newPayLoad.lblPayLoadHelp %d %i %P %s %v %V %W]
# always show or display last characters being entered on the screen.
.newUser.newPayLoad.entPayLoad xview moveto 1.0

grid .newUser.newPayLoad.lblPayLoad -row 0 -column 0 -padx 5 -pady 4
grid .newUser.newPayLoad.entPayLoad -row 0 -column 1 -padx 5 -pady 4
grid .newUser.newPayLoad.lblPayLoadHelp -row 1 -column 1 -columnspan 2

grid .newUser.newClient -row 0 -column 0
grid .newUser.newPassword  -row 1 -column 0
grid .newUser.newTopic -row 2 -column 0
grid .newUser.newPayLoad -row 0 -column 1 -rowspan 3
# ***************************************************************************

frame .btnFrame
button .btnFrame.btnAddClient -text "Add Client" -command { ClientAdd }
button .btnFrame.btnClient -text "Connect" -command { ClientConnect ::ClientID(username) ::ClientID(topic) }
button .btnFrame.btnPublish -text "Publish" -command { ClientPublish ::ClientID(username) ::ClientID(topic) ::ClientID(payload) }
button .btnFrame.btnSubscribe -text "Subscribe" -command { ClientSubscribe ::ClientID(username) ::ClientID(topic) }
button .btnFrame.btnDisconnect -text "Disconnect" -command { ClientDisconnect ::ClientID(username) ::ClientID(topic) }
button .btnFrame.btnExit -text "Exit/Cancel" -command exit

pack .btnFrame.btnClient -side left -ipadx 5 -padx 10
pack .btnFrame.btnPublish -side left -padx 5 -padx 10
pack .btnFrame.btnSubscribe -side left -padx 5 -padx 10
pack .btnFrame.btnDisconnect -side left -ipadx 5 -padx 10
pack .btnFrame.btnExit -side right -ipadx 5 -padx 10

frame .copyrightFrame
label .copyrightFrame.lblCompany -text "TclTkScripts"
label .copyrightFrame.lblCopyrightDate -text "$CopyrightDate"
pack .copyrightFrame.lblCompany -side top -padx 10 -pady 0
pack .copyrightFrame.lblCopyrightDate -side top -padx 10 -pady 0

pack .copyrightFrame -side bottom -expand no -fill x -pady 10
pack .btnFrame -side bottom -expand no -pady 15
pack .newUser -side bottom -expand no -fill x -pady 10

pack .headerFrame -side top -pady 5 -expand no -fill x
pack .brkrFrame -side left -pady 5 -padx 5 -expand yes -fill both
#pack .mqttFrame -side left -pady 5 -padx 5 -expand yes -fill both
pack .clientFrame -side top -pady 5 -padx 5 -expand yes -fill both
pack .publishFrame -side top -pady 5 -padx 5 -expand yes -fill both

# find out how big does this window really wants to be
# Get size of the window after packing all the elements
update idletasks
set wndwMain .
puts "Main $wndwMain AFTER packing."
puts "Main $wndwMain - Mapped? (0=No, 1=Yes):  [winfo ismapped $wndwMain]"
puts "Main $wndwMain - winfo reqwidth:  [winfo reqwidth $wndwMain]"
puts "Main $wndwMain - winfo reqheight:  [winfo reqheight $wndwMain]"

# Set the max height = to winfo reqheight, and increase the minimum
# width to ensure the window's title is always showing.

wm minsize $wndwMain 600 [winfo reqheight $wndwMain]

puts "wm geometry:  [wm geometry .]"
# wm geometry . 400x250+100+100
wm title . "MQTT Client/Broker Manager"
# wm geometry . 600x400+100+100

set topicAcount 0

# Clients - Publish / Subscribe
set Client01 "Redge"

puts "setupBroker"
mqtt log putMQTTmsgs
broker log putBrokerLog

# mqtt log puts

set mqttBroker [broker create mqttServer testdb.db]
puts "Broker Server Name:  $mqttBroker"

# Add user
# $mqttBroker useradd "Redge" "M!cr0J@m"
# $mqttBroker useradd "Reggie" "Vers@1yt!c$"
# public port (unsecured)

# ***************************************************************************
# Listen on port 1883
#
# Possible Error Codes
# Error connecting to broker:  couldn't open socket: address already in use

if { [catch {$mqttBroker listen 1883} fid] } {
    puts "Error connecting to broker:  $fid"
} else {
    puts "Connect to Address Already in Use"
}

Watch the MQTT Essentials video by HiveMQ for more information.

Why Use MQTT Over Other Protocols? (2021) - MQTT Masterclass

Did you find this article valuable?

Support Redge Shepherd by becoming a sponsor. Any amount is appreciated!

Learn more about Hashnode Sponsors
 
Share this