Version 4 of Peer to peer

Updated 2005-07-25 02:19:50

Zarutian 2005-07-27-01:15 Here is a super simple peer-to-peer system:

  set myIdentity empty
  set listeningPortnr 8050
  rename send old_send
  proc log {message {level 5}} {
    # redefine this proc to filter the firehose stream of log messages.
    # levels
    #   1 mind numbing detail
    #   2 less numbing
    #   3 noteworthy
    #   4 milestone
    #   5 landmark
    puts "[clock seconds]:[set level]: $message"
  }
  proc send {chan data} {
    log [info level 0] 1
    catch {
      puts $chan $data
      flush $chan
    }
  }
  proc appendToInBuffer {chan data} {
    log [info level 0] 1
    variable buffers
    append buffers($chan) $data
    append buffers($chan) "\n"
  }
  proc getInBuffer {chan} {
    log [info level 0] 1
    variable buffers
    set buffers($chan)
  }
  proc emptyInBuffer {chan} {
    log [info level 0] 1
    variable buffers
    catch {
      unset buffers($chan)
    }
  }
  proc inBufferReady {chan} {
    log [info level 0] 1
    variable buffers
    return [info complete [set buffers($chan)]]
  }
  proc dropPeer {chan} {
    log [info level 0] 1
    close $chan
    emptyInBuffer $chan
    variable connectedPeers
    set tmp [list]
    foreach peer [set connectedPeers] {
      if {"$peer" != "$chan"} {
        lappend tmp $peer
      }
    }
    set connectedPeer $tmp
  }
  proc addToConnectedPeers {chan} {
    log [info level 0] 1
    variable connectedPeers
    lappend connectedPeers $chan
  }
  proc addToKnownPeers {identity ipnr portnr} {
    log [info level 0] 1
    variable knownPeers
    lappend  knownPeers [list $identity $ipnr $portnr [clock seconds]]
  }
  proc sendToAllPeers {gram} {
    log [info level 0] 1
    variable connectedPeers
    foreach peer [set connectedPeers] {
      set chan $peer
      send $chan $gram
    }
  }
  proc announcePeerToAllPeers {identity ipnr portnr} {
    log [info level 0] 2
    sendToAllPeers "peer_anounce [list $identity] $ipnr $portnr"
  }
  proc announceAllPeersToPeer {chan} {
    variable knownPeers
    set fifteenMinutesAgo [expr [clock seconds] - 900]
    foreach peer [set knownPeers] {
      set identity  [lindex $peer 0]
      set ipnr      [lindex $peer 1]
      set portnr    [lindex $peer 2]
      set timestamp [lindex $peer 3]
      if {$fifteenMinutesAgo < $timestamp} {
        send $chan "peer_anounce $identity $ipnr $portnr 0"
      }
    }
  }
  proc accept {chan ipnr portnr} {
    log [info level 0] 2
    fconfigure $chan -encoding utf-8
    send $chan "hello $ipnr $portnr"
    send $chan "comment This is a super simple peer to peer node"
    announceAllPeersToPeer $chan
    addToConnectedPeers $chan
    fileevent $chan readable [list handle_connection $chan $ipnr]
  }
  proc handle_connection {chan ipnr} {
    log [info level 0] 2
    appendToInBuffer $chan [gets $chan]
    if {[inBufferReady $chan]} {
      handle_gram [GetInBuffer $chan] $chan $ipnr
      emptyInBuffer $chan
    }
    if {[eof $chan]} { dropPeer $chan }
  }
  proc handle_gram {gram chan ipnr} {
    log [info level 0] 3
    switch -exact -- [lindex $gram 0] {
      "your_identity?" {
        variable myIdentity
        variable listeningPortnr
        send $chan "peer_anounce [list $myIdentity] ?ip? $listeningPortnr"
        return
      }
      "peer_anounce" {
        set identity [lindex $gram 1]
        set ip       [lindex $gram 2]
        if {$ip == "?ip?"} { set ip $ipnr }
        set portnr   [lindex $gram 3]
        set hopsPassed [lindex $gram 4]
        addToKnownPeers $identity $ip $portnr
        announcePeerToAllPeers $identity $ip $portnr $hopsPassed
        return
      }

      "quit" {
        send $chan "Goodbye!"
        dropPeer $chan
        return
      }
    }
  }

...ahh damn it isnt as simple as I thought