iRules code share,only use tcp protocol profile to log tcp dns request and A or AAAA dns answers ip

proc decode_dns_package {headername result {dns_protocol_type "udp"}} {
	if { $dns_protocol_type eq "tcp" } {
		set result [string range $result 2 end]
	}
    binary scan $result @6H4 answer_RRS			
	set answer_count [scan $answer_RRS {%x}]
	# set list_hex_ip {}
	for {set rr 0; set answer_data_length 0; set list_hex_ip {}} {$rr < $answer_count} {incr rr} {	
		set catch_result [binary scan $result @[expr {[string length $headername] + 12 * $rr + $answer_data_length + 2}]H4 hex_answer_type]
		if { $catch_result == 1 } {
		    set answer_type [scan $hex_answer_type {%x}]
			if { $answer_type == 28 } {
				binary scan $result @[expr {[string length $headername] + 12 * $rr + $answer_data_length + 12}]H32 hex_ip
				lappend list_hex_ip $hex_ip
				incr answer_data_length 16
				set dns_type_aaaa 1 
			} elseif { $answer_type == 1 } {
				binary scan $result @[expr {[string length $headername] + 12 * $rr + $answer_data_length + 12}]H8 hex_ip
				lappend list_hex_ip $hex_ip
				incr answer_data_length 4
				set dns_type_a 1
			} else {
			    binary scan $result @[expr {[string length $headername] + 12 * $rr + $answer_data_length + 10}]H4 hex_data_length
				incr answer_data_length [scan $hex_data_length {%x}]
			}
		}
	}
	set dns_answer_list {}
	if { [llength $list_hex_ip] == 0 } {
		set dns_answer_list {}
	} else {
		if { [info exists dns_type_aaaa] } {
			foreach dns_aaaa_ipv6 $list_hex_ip {
				for {set i 1; set aaaa_ipv6 [string range $dns_aaaa_ipv6 0 3]} { $i <= 7 } {incr i} {
					append aaaa_ipv6 ":[string range $dns_aaaa_ipv6 [expr {$i * 4}] [expr {$i * 4 + 3}]]"
				}
				set compress_ipv6 [IP::addr $aaaa_ipv6 mask ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff]
				lappend dns_answer_list $compress_ipv6
			}
		} else {
			foreach dns_a_ip $list_hex_ip {	
				scan $dns_a_ip {%2x%2x%2x%2x} ip1 ip2 ip3 ip4
				set a_ipv4 "$ip1.$ip2.$ip3.$ip4"
				lappend dns_answer_list $a_ipv4
			}
		}
	}
	return $dns_answer_list
}

proc decode_dns_query_name {dns_query_post {dns_protocol_type "udp"}} {
	if { $dns_protocol_type eq "udp" } {
		set dns_query_post $dns_query_post
	} else {
		set dns_query_post [string range $dns_query_post 2 end]
	}
    for {set i 0;set offset 12;set length 1;set endlength 1;set query_name ""} { $length > 0 && $i < 10 } { incr i } {
		binary scan [string range $dns_query_post $offset $offset] c foo
		set length [expr {$foo & 0xff}]
		if { $length > 0 } {
			append query_name [string range $dns_query_post [expr {$offset + 1}] [expr {$offset + $length}]]
			set offset [expr {$offset + $length + 1}]
			binary scan [string range $dns_query_post $offset $offset] c foo
			set endlength [expr {$foo & 0xff}]
			if { $endlength > 0 } {
				append query_name "."
			}
		}
	}
	return $query_name
}

when RULE_INIT {
    array set static::dns_type_array {
        1 "A"
        28 "AAAA"
        5 "CNAME"
        2 "NS"
        6 "SOA"
        12 "PTR"
        15 "MX"
        16 "TXT"
        33 "SRV"
        35 "NAPTR"
        10 "NULL"
        46 "RRSIG"
        48 "DNSKEY"
        52 "TLSA"
        65 "HTTPS"
        251 "IXFR"
        252 "AXFR"
        255 "ANY"
        256 "URI"
        257 "CAA"
    }
}
when CLIENT_ACCEPTED priority 500 {
      set hsl [HSL::open -proto UDP -pool syslog_pool]
	TCP::collect
}

when CLIENT_DATA priority 500 {
    set client_dns_query_packet [TCP::payload]
	set dns_query_name [call decode_dns_query_name $client_dns_query_packet "tcp"]
	# set header_name_length [expr {12 + 1 + [string length $dns_query_name] + 1 + 2 + 2}]

	binary scan $client_dns_query_packet @2H4 hex_dns_query_id
	binary scan $client_dns_query_packet @[expr {2 + 12 + 1 + [string length $dns_query_name] + 1}]H4 hex_dns_type
	set dns_question_type [lindex [array get static::dns_type_array [scan $hex_dns_type {%x}]] 1]
	if { $dns_question_type eq "A" or $dns_question_type eq "AAAA" } {
		set answer_decode_action 1
	}
	# log local0. "client ip is [IP::client_addr], dns question name is $dns_query_name, query id is [scan $hex_dns_query_id {%x}], query type is $dns_question_type"
        HSL::send $hsl "client ip is [IP::client_addr], dns question name is $dns_query_name, query id is [scan $hex_dns_query_id {%x}], query type is $dns_question_type"
	TCP::release
}
when SERVER_CONNECTED priority 500 {
	if { [info exists answer_decode_action] } {
		set collect_server_data 1
		TCP::collect
	} else {
		return
	}
}
when SERVER_DATA priority 500 {
	if { [info exists collect_server_data] } {
		set dns_answer_packet [TCP::payload]
    	if { [string length $dns_answer_packet] > 12 } {
        	# log local0. "haha"
        	binary scan $dns_answer_packet @4H4 rcode
        	set replay_code [scan [string range $rcode end end] {%x}]
        	# log local0. "replay_code is $replay_code"
        	if { $replay_code == 0 } {
        	    set header_name_length [expr {12 + 1 + [string length $dns_query_name] + 1 + 2 + 2}]
                set headername [TCP::payload 2 $header_name_length]
                # log local0. "length is [string length $headername]"
           		set tcp_answer_result [call decode_dns_package $headername $dns_answer_packet "tcp"]
            	# log local0. "client ip is [IP::client_addr], dns query id is [scan $hex_dns_query_id {%x}], dns question name is $dns_query_name, dns query type is $dns_question_type, dns answer is $tcp_answer_result"
                HSL::send $hsl "client ip is [IP::client_addr], dns query id is [scan $hex_dns_query_id {%x}], dns question name is $dns_query_name, dns query type is $dns_question_type, dns answer is $tcp_answer_result"
        	} else {
            	# log local0. "dns answer is empty, because dns replay_code is $replay_code"
                HSL::send $hsl "dns answer is empty, because dns replay_code is $replay_code"
        	}
    	}
		TCP::release
	} else {
		return
	}
}

iRules has make a little modifications:

syslog local0.  has been modified to HSL