httpmodel.tcl

采用蚂蚁算法实现ad hoc网络路由协议,平台为ns2

#
# Copyright (c) 1997 Regents of the University of California.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#  This product includes software developed by the Computer Systems
#  Engineering Group at Lawrence Berkeley Laboratory.
# 4. Neither the name of the University nor of the Laboratory may be used
#    to endorse or promote products derived from this software without
#    specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.

## The http client-server object library.
## Emile Sahouria 3/10/97


# WWW client and server classes.

global WWWverbose_
set WWWverbose_ 0

Class WWWClient

WWWClient instproc init {cnode ns} {
    $self instvar cnode_ ns_ numTrans_ runningAvg_ replyLen_ replyFinTime_ \
	    replyStartTime_ totalPackets_ tcpList_ tcpType_  
    set cnode_ $cnode
    set ns_ $ns
    set runningAvg_ 0
    set numTrans_ 0
    set replyLen_ 0
    set replyStartTime_ 0
    set replyFinTime_ 1
    set totalPackets_ 0
    set running_ 0 
    set tcpType_ Reno
}

# Wait for some "think time".  Then, send one or more packets to the server.
WWWClient instproc start server {
    global requestCdf thinkCdf WWWverbose_
    $self instvar ns_ server_ requestLength_ cnode_ reqTcp_ reqTcpSink_ \
		reqFtp_ numTrans_ runningAvg_ running_ tcpType_ 

    $self stats

    set server_ $server

    set running_ 1

    # Start request connection, with callback to client timeout method.
    set requestLength_ [$requestCdf param]
    set requestPkts_ [expr $requestLength_/1000]
    set requestPkts_ [expr {($requestPkts_ > 0) ? [expr $requestPkts_ + 1]: 1}]

    set reqFtp_ [new Application/FTP]

    if {$tcpType_ == "Newreno" || $tcpType_ == "Reno"} {
        set reqTcp_ [new Agent/TCP/$tcpType_]
    } else {
        set reqTcp_ [new Agent/TCP]
    }
    $reqTcp_ set_callback $self
    #$reqTcp_ set_pkttype 31 
    $reqTcp_ reset ; # Necessary for later connections
    set reqTcpSink_ [new Agent/TCPSink]
    
    $reqTcpSink_ reset; # contributed by UF
    $ns_ attach-agent $cnode_ $reqTcp_
    $ns_ attach-agent [$server set snode_] $reqTcpSink_
    $reqFtp_ attach-agent $reqTcp_

    set think [$thinkCdf param]
    if {$WWWverbose_ == 1} {
	puts "Client $self sleeps (think time) until [format "%.3f" [expr [$ns_ now] + $think]]"
	puts ""
    	puts "Client $self request packet of length $requestLength_ at time [format "%.3f" [expr [$ns_ now] + $think]]"
    }
    $ns_ at [expr [$ns_ now] + $think] "$ns_ connect $reqTcp_ $reqTcpSink_; \
	    $reqTcp_ set packetSize_ $requestLength_; \
   	    $reqFtp_ send $requestLength_"
    incr numTrans_
}

# Our request connection is done.  Start the server, which will generate
# one or more reply connections containing server data.
WWWClient instproc timeout tcp {
    $self instvar ns_ requestLength_ cnode_ server_ reqTcp_ reqTcpSink_ reqFtp_ \
	    replyStartTime_ running_
    # Terminate the request connection.
    $reqFtp_ destroy
    # This should not be necessary, but it seems to be. 
    $reqTcp_ reset
    $reqTcpSink_ reset; # contributed by UF
    $ns_ detach-agent $cnode_ $reqTcp_
    $ns_ detach-agent [$server_ set snode_] $reqTcpSink_

    # server now running 
    set running_ 0

    # Tell the server to start.
    set replyStartTime_ [$ns_ now]
    $server_ start $self
}

WWWClient instproc stats {} {
    $self instvar runningAvg_ replyLen_ replyStartTime_ replyFinTime_ numTrans_ \
	    totalPackets_

    # Calculate current response throughput.
    set aveThru [expr $replyLen_ / ( $replyFinTime_ - $replyStartTime_ )]

    # Combine with running average:
    set runningAvg_ [expr ($runningAvg_ * $numTrans_ + $aveThru) \
	    / ($numTrans_ + 1)]

    # Tally total number of packets received so far.
    incr totalPackets_ $replyLen_

    # Clear the reply length variable so the server can set it again.
    set replyLen_ 0
}

WWWClient instproc statDump interval {
    $self instvar runningAvg_ replyLen_ replyStartTime_ replyFinTime_ numTrans_ \
	    totalPackets_ ns_
    
    puts "client $self: running average throughput = $runningAvg_ packets/s"
    puts " "
    $ns_ at [expr [$ns_ now] + $interval] "$self statDump $interval"
}

Class WWWServer

WWWServer instproc init {snode ns} {
    $self instvar snode_ ns_ tcpType_ 
    set snode_ $snode
    set ns_ $ns
    set tcpType_ Reno
}

# Generate some number of connections to the client. start them all
# at the same time
WWWServer instproc start client {
    global connCdf replyCdf WWWverbose_
    $self instvar ns_ replyLength_ snode_ numReplies_ \
	    connList_ numFinished_ tcpType_

    set numFinished_($client) 0

    # Start reply connections, with callbacks to server timeout method.
    set numReplies_($client) [$connCdf param]

    if {$WWWverbose_ == 1} {
    	puts "Server $self responds with $numReplies_($client) reply(s) to client $client at time [format "%.3f" [$ns_ now]]"
    }
    for {set i 0} {$i < $numReplies_($client)} {incr i} {
	# Here, the server response is in 1000 byte packets
	set replyLength_ [$replyCdf param]

	set replyPkts_ [expr $replyLength_/1000]
	set replyPkts_ [expr {($replyPkts_ > 0) ? [expr $replyPkts_ + 1] : 1}]
	
	$self instvar tcpList_ ; #used to keep track of all active tcp sources

	$self instvar repFtp_${i}_ repTcp_${i}_ repTcpSink_${i}_
	set repFtp_${i}_ [new Application/FTP]

	if {$tcpType_ == "Newreno" || $tcpType_ == "Reno"} {
		set repTcp_${i}_ [new Agent/TCP/$tcpType_]
	} else {
		set repTcp_${i}_ [new Agent/TCP]
	}
	[set repTcp_${i}_] set_callback $self
	[set repTcp_${i}_] reset
    	#[set repTcp_${i}_] set_pkttype 31 
	$client set tcpList_([set repTcp_${i}_]) 1

	set repTcpSink_${i}_ [new Agent/TCPSink]
	[set repTcpSink_${i}_] reset; # contributed by UF

	# The association between TCP agent and the sink, ftp source.
	set connList_([set repTcp_${i}_]) [list [set repTcpSink_${i}_] \
		[set repFtp_${i}_] $client]
	
	$ns_ attach-agent $snode_ [set repTcp_${i}_]
	$ns_ attach-agent [$client set cnode_] [set repTcpSink_${i}_]
	[set repFtp_${i}_] attach-agent [set repTcp_${i}_]
	
	$ns_ connect [set repTcp_${i}_] [set repTcpSink_${i}_]
	# If the reply length is less than 1000 bytes, send it in one packet
	# of that length.  If it is greater than 1000 bytes, send it in 
	# however many 1000 bytes packets are needed (i.e., round up to nearest
	# 1000 bytes
	if {$replyLength_ > 1000 } {
		[set repTcp_${i}_] set packetSize_ 1000
		[set repFtp_${i}_] produce $replyPkts_
	} else {
		[set repTcp_${i}_] set packetSize_ $replyLength_
		[set repFtp_${i}_] send $replyLength_
	}
    	if {$WWWverbose_ == 1} {
    		puts "Server $self reply [expr $i + 1] is of length $replyLength_ ($replyPkts_ pkts) to client $client at time [format "%.3f" [$ns_ now]]"
    	}
    }
}

WWWServer instproc getActive client {
	$self instvar connList_ numFinished_ numReplies_ 
	$client instvar tcpList_

	set active_ 0

	set namelist [array names tcpList_]
	foreach j $namelist {
		set temp_ [expr [$j set ack_] + 1]
		if {$temp_ > 0} {
			incr active_ $temp_
		} else {
		}
	} 
	return $active_
}

WWWServer instproc timeout tcp {
    global thinkCdf
    $self instvar ns_ snode_ connList_ numFinished_ numReplies_ 
    
    # Terminate the reply connection.
    set conn $connList_($tcp)
    set repTcpSink [lindex $conn 0]
    set repFtp [lindex $conn 1]
    set client [lindex $conn 2]

	$client unset tcpList_($tcp)

    $repFtp destroy
    # reset as in WWWClient's instproc timeout tcp-- contributed by UF(2 lines)
    $tcp reset   	 
    $repTcpSink reset
    $ns_ detach-agent $snode_ $tcp
    $ns_ detach-agent [$client set cnode_] $repTcpSink

    $client set replyLen_ [expr [$client set replyLen_] + [$tcp set ack_] + 1]
    
    incr numFinished_($client)

    # Tell the client to start if all connections are finished.
    if {$numFinished_($client) == $numReplies_($client)} {
	$client set replyFinTime_ [$ns_ now]
	$client start $self
    }
}

# Random paramenter generation
# This derived from an example in some Tcl book...

Class Random 

Random instproc init seed {
    $self instvar ia_ ic_ im_ seed_
    #just use seconds as the seed
    set seed_ 1[lindex [split [lindex [exec date] 3] :] 2]
    set ia_ 9301
    set ic_ 49297
    set im_ 233280
}

Random instproc random {} {
    $self instvar ia_ ic_ im_ seed_
    set seed_  [expr ( ($seed_ * $ia_) + $ic_ ) % $im_]
    return [expr $seed_ / double($im_)]
}

Random instproc randomRange range {
    expr [$self random] * $range
}

# Implement inverse cdf transform--2 ways: exact or sampled.
# This allows cdf's with few points to be accurately represented,
# and cdf's with many points to be efficiently approximated.

Class Random/exactCdf -superclass Random

Random/exactCdf instproc init {seed file} {
    $self next $seed
    $self instvar file_ length_ cdf_
    set file_ [open $file r]
    set length_ 0
    while {[gets $file_ line] > 0} {
	lappend cdf_ [list [lindex $line 0] [lindex $line 2]]
	incr length_
    }
}

Random/exactCdf instproc param {} {
    $self instvar length_ cdf_
    set index [$self randomRange 1]
    for {set i 0} {$i < $length_} {incr i} {
	set entry [lindex $cdf_ $i]
	if {[lindex $entry 1] >= $index} {
	    return [lindex $entry 0]
	}
    }
}

Class Random/sampledCdf -superclass Random

Random/sampledCdf instproc init {seed file} {
    $self next $seed
    $self instvar file_ length_ cdf_
    set file_ [open $file r]
    set length_ 0
    while {[gets $file_ line] > 0} {
	set cdf_($length_) $line
	incr length_
    }
    incr length_ -1; # Avoid fencepost error.
}

Random/sampledCdf instproc param {} {
    $self instvar length_ cdf_
    set index [expr round([$self randomRange $length_]) ]
    return $cdf_($index)
}

# Create the cdf's.
proc initCdfs {ns} {
    global connCdf stayCdf thinkCdf replyCdf requestCdf
    set connCdf [new Random/exactCdf [$ns now] HttpConnections.cdf]
    set stayCdf [new Random/exactCdf [$ns now] HttpServerStay.cdf]
    set thinkCdf [new Random/sampledCdf [$ns now] regHttpThinkTime.cdf]
    set replyCdf [new Random/sampledCdf [$ns now] regHttpReplyLength.cdf]
    set requestCdf [new Random/sampledCdf [$ns now] regHttpRequestLength.cdf]
}

# Callback methods
# Required methods for Agent/TCP/*
# The following TCP types can be used:  
# Tahoe (Agent/TCP), Reno (Agent/TCP/Reno), and Newreno (Agent/TCP/Newreno)
# It can be extended to others as well, but the above code may need to be
# changed.
# Note:  This http generator is not suitable for use with FullTcp; use
# the generator in ns/tcl/http instead.

Agent/TCP/Newreno instproc set_callback callback {
    $self instvar callback_
    set callback_ $callback
}

Agent/TCP/Newreno instproc done {} {
    $self instvar callback_
    $callback_ timeout $self
}

Agent/TCP/Reno instproc set_callback callback {
    $self instvar callback_
    set callback_ $callback
}

Agent/TCP/Reno instproc done {} {
    $self instvar callback_
    $callback_ timeout $self
}

Agent/TCP instproc set_callback callback {
    $self instvar callback_
    set callback_ $callback
}

Agent/TCP instproc done {} {
    $self instvar callback_
    $callback_ timeout $self
}