├── .gitignore ├── .gitmodules ├── LICENSE.txt ├── Makefile ├── README.md ├── etherscope.gpr ├── gnat.adc └── src ├── etheroscope.adb ├── etherscope-analyzer-base.adb ├── etherscope-analyzer-base.ads ├── etherscope-analyzer-ethernet.adb ├── etherscope-analyzer-ethernet.ads ├── etherscope-analyzer-igmp.adb ├── etherscope-analyzer-igmp.ads ├── etherscope-analyzer-ipv4.adb ├── etherscope-analyzer-ipv4.ads ├── etherscope-analyzer-tcp.adb ├── etherscope-analyzer-tcp.ads ├── etherscope-analyzer.ads ├── etherscope-display.adb ├── etherscope-display.ads ├── etherscope-receiver.adb ├── etherscope-receiver.ads ├── etherscope-stats.adb ├── etherscope-stats.ads ├── etherscope.ads ├── ui-buttons.adb ├── ui-buttons.ads ├── ui-graphs.adb ├── ui-graphs.ads ├── ui-texts.adb ├── ui-texts.ads └── ui.ads /.gitignore: -------------------------------------------------------------------------------- 1 | obj 2 | *~ 3 | *.log 4 | *.bin 5 | 6 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "ada-enet"] 2 | path = ada-enet 3 | url = git@github.com:stcarrez/ada-enet.git 4 | [submodule "Ada_Drivers_Library"] 5 | path = Ada_Drivers_Library 6 | url = git://github.com/AdaCore/Ada_Drivers_Library.git 7 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Apache License 2 | Version 2.0, January 2004 3 | http://www.apache.org/licenses/ 4 | 5 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 6 | 7 | 1. Definitions. 8 | 9 | "License" shall mean the terms and conditions for use, reproduction, 10 | and distribution as defined by Sections 1 through 9 of this document. 11 | 12 | "Licensor" shall mean the copyright owner or entity authorized by 13 | the copyright owner that is granting the License. 14 | 15 | "Legal Entity" shall mean the union of the acting entity and all 16 | other entities that control, are controlled by, or are under common 17 | control with that entity. For the purposes of this definition, 18 | "control" means (i) the power, direct or indirect, to cause the 19 | direction or management of such entity, whether by contract or 20 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 21 | outstanding shares, or (iii) beneficial ownership of such entity. 22 | 23 | "You" (or "Your") shall mean an individual or Legal Entity 24 | exercising permissions granted by this License. 25 | 26 | "Source" form shall mean the preferred form for making modifications, 27 | including but not limited to software source code, documentation 28 | source, and configuration files. 29 | 30 | "Object" form shall mean any form resulting from mechanical 31 | transformation or translation of a Source form, including but 32 | not limited to compiled object code, generated documentation, 33 | and conversions to other media types. 34 | 35 | "Work" shall mean the work of authorship, whether in Source or 36 | Object form, made available under the License, as indicated by a 37 | copyright notice that is included in or attached to the work 38 | (an example is provided in the Appendix below). 39 | 40 | "Derivative Works" shall mean any work, whether in Source or Object 41 | form, that is based on (or derived from) the Work and for which the 42 | editorial revisions, annotations, elaborations, or other modifications 43 | represent, as a whole, an original work of authorship. For the purposes 44 | of this License, Derivative Works shall not include works that remain 45 | separable from, or merely link (or bind by name) to the interfaces of, 46 | the Work and Derivative Works thereof. 47 | 48 | "Contribution" shall mean any work of authorship, including 49 | the original version of the Work and any modifications or additions 50 | to that Work or Derivative Works thereof, that is intentionally 51 | submitted to Licensor for inclusion in the Work by the copyright owner 52 | or by an individual or Legal Entity authorized to submit on behalf of 53 | the copyright owner. For the purposes of this definition, "submitted" 54 | means any form of electronic, verbal, or written communication sent 55 | to the Licensor or its representatives, including but not limited to 56 | communication on electronic mailing lists, source code control systems, 57 | and issue tracking systems that are managed by, or on behalf of, the 58 | Licensor for the purpose of discussing and improving the Work, but 59 | excluding communication that is conspicuously marked or otherwise 60 | designated in writing by the copyright owner as "Not a Contribution." 61 | 62 | "Contributor" shall mean Licensor and any individual or Legal Entity 63 | on behalf of whom a Contribution has been received by Licensor and 64 | subsequently incorporated within the Work. 65 | 66 | 2. Grant of Copyright License. Subject to the terms and conditions of 67 | this License, each Contributor hereby grants to You a perpetual, 68 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 69 | copyright license to reproduce, prepare Derivative Works of, 70 | publicly display, publicly perform, sublicense, and distribute the 71 | Work and such Derivative Works in Source or Object form. 72 | 73 | 3. Grant of Patent License. Subject to the terms and conditions of 74 | this License, each Contributor hereby grants to You a perpetual, 75 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 76 | (except as stated in this section) patent license to make, have made, 77 | use, offer to sell, sell, import, and otherwise transfer the Work, 78 | where such license applies only to those patent claims licensable 79 | by such Contributor that are necessarily infringed by their 80 | Contribution(s) alone or by combination of their Contribution(s) 81 | with the Work to which such Contribution(s) was submitted. If You 82 | institute patent litigation against any entity (including a 83 | cross-claim or counterclaim in a lawsuit) alleging that the Work 84 | or a Contribution incorporated within the Work constitutes direct 85 | or contributory patent infringement, then any patent licenses 86 | granted to You under this License for that Work shall terminate 87 | as of the date such litigation is filed. 88 | 89 | 4. Redistribution. You may reproduce and distribute copies of the 90 | Work or Derivative Works thereof in any medium, with or without 91 | modifications, and in Source or Object form, provided that You 92 | meet the following conditions: 93 | 94 | (a) You must give any other recipients of the Work or 95 | Derivative Works a copy of this License; and 96 | 97 | (b) You must cause any modified files to carry prominent notices 98 | stating that You changed the files; and 99 | 100 | (c) You must retain, in the Source form of any Derivative Works 101 | that You distribute, all copyright, patent, trademark, and 102 | attribution notices from the Source form of the Work, 103 | excluding those notices that do not pertain to any part of 104 | the Derivative Works; and 105 | 106 | (d) If the Work includes a "NOTICE" text file as part of its 107 | distribution, then any Derivative Works that You distribute must 108 | include a readable copy of the attribution notices contained 109 | within such NOTICE file, excluding those notices that do not 110 | pertain to any part of the Derivative Works, in at least one 111 | of the following places: within a NOTICE text file distributed 112 | as part of the Derivative Works; within the Source form or 113 | documentation, if provided along with the Derivative Works; or, 114 | within a display generated by the Derivative Works, if and 115 | wherever such third-party notices normally appear. The contents 116 | of the NOTICE file are for informational purposes only and 117 | do not modify the License. You may add Your own attribution 118 | notices within Derivative Works that You distribute, alongside 119 | or as an addendum to the NOTICE text from the Work, provided 120 | that such additional attribution notices cannot be construed 121 | as modifying the License. 122 | 123 | You may add Your own copyright statement to Your modifications and 124 | may provide additional or different license terms and conditions 125 | for use, reproduction, or distribution of Your modifications, or 126 | for any such Derivative Works as a whole, provided Your use, 127 | reproduction, and distribution of the Work otherwise complies with 128 | the conditions stated in this License. 129 | 130 | 5. Submission of Contributions. Unless You explicitly state otherwise, 131 | any Contribution intentionally submitted for inclusion in the Work 132 | by You to the Licensor shall be under the terms and conditions of 133 | this License, without any additional terms or conditions. 134 | Notwithstanding the above, nothing herein shall supersede or modify 135 | the terms of any separate license agreement you may have executed 136 | with Licensor regarding such Contributions. 137 | 138 | 6. Trademarks. This License does not grant permission to use the trade 139 | names, trademarks, service marks, or product names of the Licensor, 140 | except as required for reasonable and customary use in describing the 141 | origin of the Work and reproducing the content of the NOTICE file. 142 | 143 | 7. Disclaimer of Warranty. Unless required by applicable law or 144 | agreed to in writing, Licensor provides the Work (and each 145 | Contributor provides its Contributions) on an "AS IS" BASIS, 146 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 147 | implied, including, without limitation, any warranties or conditions 148 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 149 | PARTICULAR PURPOSE. You are solely responsible for determining the 150 | appropriateness of using or redistributing the Work and assume any 151 | risks associated with Your exercise of permissions under this License. 152 | 153 | 8. Limitation of Liability. In no event and under no legal theory, 154 | whether in tort (including negligence), contract, or otherwise, 155 | unless required by applicable law (such as deliberate and grossly 156 | negligent acts) or agreed to in writing, shall any Contributor be 157 | liable to You for damages, including any direct, indirect, special, 158 | incidental, or consequential damages of any character arising as a 159 | result of this License or out of the use or inability to use the 160 | Work (including but not limited to damages for loss of goodwill, 161 | work stoppage, computer failure or malfunction, or any and all 162 | other commercial damages or losses), even if such Contributor 163 | has been advised of the possibility of such damages. 164 | 165 | 9. Accepting Warranty or Additional Liability. While redistributing 166 | the Work or Derivative Works thereof, You may choose to offer, 167 | and charge a fee for, acceptance of support, warranty, indemnity, 168 | or other liability obligations and/or rights consistent with this 169 | License. However, in accepting such obligations, You may act only 170 | on Your own behalf and on Your sole responsibility, not on behalf 171 | of any other Contributor, and only if You agree to indemnify, 172 | defend, and hold each Contributor harmless for any liability 173 | incurred by, or claims asserted against, such Contributor by reason 174 | of your accepting any such warranty or additional liability. 175 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # Helper makefile to build etherscope, make the image and flash it. 2 | 3 | all: etherscope 4 | 5 | ada-enet/anet_stm32fxxx.gpr: 6 | cd ada-enet && ./configure --with-board=stm32f746 7 | 8 | etherscope: ada-enet/anet_stm32fxxx.gpr 9 | arm-eabi-gnatmake -Petherscope -p -cargs -mno-unaligned-access 10 | arm-eabi-objcopy -O binary obj/stm32f746disco/etheroscope etherscope.bin 11 | 12 | flash: all 13 | st-flash write etherscope.bin 0x8000000 14 | 15 | checkout: 16 | git submodule init 17 | git submodule update 18 | cd ada-enet/Ada_Drivers_Library && git submodule init && git submodule update 19 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Ethernet Traffic Monitor on a STM32F746 2 | 3 | [![Build Status](https://img.shields.io/jenkins/s/http/jenkins.vacs.fr/etherscope.svg)](http://jenkins.vacs.fr/job/etherscope/) 4 | [![License](http://img.shields.io/badge/license-APACHE2-blue.svg)](LICENSE) 5 | ![Commits](https://img.shields.io/github/commits-since/stcarrez/etherscope/1.0.0.svg) 6 | 7 | EtherScope is a monitoring tool that analyzes the Ethernet traffic. 8 | It runs on a STM32F746 board, reads the Ethernet packets, do some 9 | realtime analysis and displays the results on the 480x272 touch panel. 10 | 11 | The EtherScope interface allows to filter the results at different 12 | levels: 13 | 14 | * Get and display statistics at the Ethernet level, 15 | * Display information at some protocol levels: IPv4, TCP, UDP, ICMP 16 | 17 | The EtherScope uses the following two GitHub projects: 18 | 19 | * Ada_Drivers_Library https://github.com/AdaCore/Ada_Drivers_Library.git 20 | 21 | * Ada Embedded Network https://github.com/stcarrez/ada-enet.git 22 | 23 | You need the source of these two projects to buid EtherScope. 24 | To help, these GitHub projects are registered as Git submodules and 25 | the Makefile provides a target to perform the checkout. Just run: 26 | 27 | make checkout 28 | 29 | You will also need the GNAT Ada compiler for ARM available at http://libre.adacore.com/ 30 | 31 | # Build 32 | 33 | Run the command: 34 | 35 | make 36 | 37 | to build the application and get the EtherScope image 'etherscope.bin'. 38 | Then, flash the image with: 39 | 40 | st-flash write etherscope.bin 0x8000000 41 | 42 | or just 43 | 44 | make flash 45 | 46 | # Using EtherScope 47 | 48 | To look at the network traffic, it is recommended to have a switch that supports 49 | port monitoring. The switch is configured to monitor all the traffic to a given 50 | port. The EtherScope is then connected to that port and it will receive all the 51 | traffic, including the packets not destined to the board. 52 | 53 | You can still use EtherScope without a switch and port mirroring but the EtherScope 54 | will not be able to see all the network packets. Without port mirroring, we can 55 | only see multicast and broadcast traffic, which means: ARP, ICMP, IGMP and UDP 56 | packets on multicast groups. 57 | 58 | Once powered up, the EtherScope starts the analysis and offers 4 buttons to 59 | switch to different display modes: 60 | 61 | * Ether displays the list of devices found on the network. 62 | * Proto displays the different IPv4 protocols found on the network. 63 | * IGMP displays the UDP multicast groups which are subscribed on the network. 64 | * TCP displays the list of high level application protocols (http, https, ssh, ...). 65 | 66 | 67 | The following screenshot shows the TCP panel with 3 recognized TCP protocols and a running 68 | SCP that uses almost all the bandwidth. 69 | 70 | ![](https://github.com/stcarrez/etherscope/wiki/images/etherscope-v1.png) 71 | 72 | # Publication 73 | 74 | * The EtherScope project was submitted to the [Make with Ada](http://www.makewithada.org/) competition. 75 | 76 | * Article: [Ethernet Traffic Monitor on a STM32F746](http://blog.vacs.fr/vacs/blogs/post.html?post=2016/09/30/Ethernet-Traffic-Monitor-on-a-STM32F746) 77 | 78 | * Article: [Using the Ada Embedded Network STM32 Ethernet Driver](http://blog.vacs.fr/vacs/blogs/post.html?post=2016/09/29/Using-the-Ada-Embedded-Network-STM32-Ethernet-Driver) 79 | 80 | * Video: [EtherScope an Ethernet Traffic Monitor](https://youtu.be/zEtA-S5jvfY) 81 | -------------------------------------------------------------------------------- /etherscope.gpr: -------------------------------------------------------------------------------- 1 | with "ada-enet/Ada_Drivers_Library/boards/stm32f746_discovery/stm32f746_discovery"; 2 | with "ada-enet/anet_stm32fxxx"; 3 | 4 | project Etherscope extends "ada-enet/Ada_Drivers_Library/examples/shared/common/common.gpr" is 5 | 6 | for Runtime ("Ada") use STM32F746_Discovery'Runtime("Ada"); 7 | for Object_Dir use "obj/stm32f746disco"; 8 | 9 | for Main use ("etheroscope.adb"); 10 | for Source_Dirs use ("src", "ada-enet/Ada_Drivers_Library/examples/shared/common/gui"); 11 | 12 | package Compiler is 13 | -- The network packets are stored in the SDRAM and the SDRAM raises a hardware 14 | -- fault when we access un-aligned 32-bit words. 15 | for Default_Switches ("Ada") 16 | use Anet_STM32FXXX.Compiler'Default_Switches ("Ada"); 17 | end Compiler; 18 | 19 | package Builder is 20 | for Global_Configuration_Pragmas use "gnat.adc"; 21 | end Builder; 22 | 23 | end Etherscope; 24 | -------------------------------------------------------------------------------- /gnat.adc: -------------------------------------------------------------------------------- 1 | -- pragma Profile (GNAT_Extended_Ravenscar); 2 | 3 | pragma Partition_Elaboration_Policy (Sequential); 4 | 5 | -------------------------------------------------------------------------------- /src/etheroscope.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etheroscope -- Ether Oscope main program 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with System; 19 | with Interfaces; 20 | 21 | with Ada.Real_Time; 22 | 23 | with STM32.Board; 24 | with STM32.RNG.Interrupts; 25 | with STM32.Eth; 26 | with STM32.SDRAM; 27 | with HAL.Bitmap; 28 | 29 | with Net; 30 | with Net.Buffers; 31 | with UI.Buttons; 32 | with EtherScope.Display; 33 | with EtherScope.Receiver; 34 | with EtherScope.Stats; 35 | 36 | -- The main EtherScope task must run at a lower priority as it takes care 37 | -- of displaying results on the screen while the EtherScope receiver's task 38 | -- waits for packets and analyzes them. All the hardware initialization must 39 | -- be done here because STM32.SDRAM is not protected against concurrent accesses. 40 | procedure Etheroscope with Priority => System.Priority'First is 41 | 42 | use type Interfaces.Unsigned_32; 43 | use type UI.Buttons.Button_Index; 44 | use type Ada.Real_Time.Time; 45 | use type Ada.Real_Time.Time_Span; 46 | 47 | -- Reserve 32 network buffers. 48 | NET_BUFFER_SIZE : constant Interfaces.Unsigned_32 := Net.Buffers.NET_ALLOC_SIZE * 32; 49 | 50 | -- Display refresh period. 51 | REFRESH_PERIOD : constant Ada.Real_Time.Time_Span := Ada.Real_Time.Milliseconds (500); 52 | 53 | -- Display refresh deadline. 54 | Refresh_Deadline : Ada.Real_Time.Time; 55 | 56 | -- Current display mode. 57 | Mode : UI.Buttons.Button_Event := EtherScope.Display.B_ETHER; 58 | Button_Changed : Boolean := False; 59 | 60 | -- Display the Ethernet graph (all traffic). 61 | Graph_Mode : EtherScope.Stats.Graph_Kind := EtherScope.Stats.G_ETHERNET; 62 | begin 63 | STM32.RNG.Interrupts.Initialize_RNG; 64 | 65 | -- Initialize the display and draw the main/fixed frames in both buffers. 66 | EtherScope.Display.Initialize; 67 | EtherScope.Display.Draw_Frame (STM32.Board.Display.Hidden_Buffer (1).all); 68 | STM32.Board.Display.Update_Layer (1); 69 | EtherScope.Display.Draw_Frame (STM32.Board.Display.Hidden_Buffer (1).all); 70 | 71 | -- Initialize the Ethernet driver. 72 | STM32.Eth.Initialize_RMII; 73 | 74 | -- Static IP interface, default netmask and no gateway. 75 | -- (In fact, this is not really necessary for using the receiver in promiscus mode) 76 | EtherScope.Receiver.Ifnet.Ip := (192, 168, 1, 1); 77 | 78 | -- STMicroelectronics OUI = 00 81 E1 79 | EtherScope.Receiver.Ifnet.Mac := (0, 16#81#, 16#E1#, 5, 5, 1); 80 | 81 | -- Setup some receive buffers and initialize the Ethernet driver. 82 | Net.Buffers.Add_Region (STM32.SDRAM.Reserve (Amount => HAL.UInt32 (NET_BUFFER_SIZE)), NET_BUFFER_SIZE); 83 | EtherScope.Receiver.Ifnet.Initialize; 84 | EtherScope.Receiver.Start; 85 | 86 | Refresh_Deadline := Ada.Real_Time.Clock + REFRESH_PERIOD; 87 | 88 | -- Loop to retrieve the analysis and display them. 89 | loop 90 | declare 91 | Action : UI.Buttons.Button_Event; 92 | Now : constant Ada.Real_Time.Time := Ada.Real_Time.Clock; 93 | Buffer : constant HAL.Bitmap.Any_Bitmap_Buffer := STM32.Board.Display.Hidden_Buffer (1); 94 | begin 95 | -- We updated the buttons in the previous layer and 96 | -- we must update them in the second one. 97 | if Button_Changed then 98 | EtherScope.Display.Draw_Buttons (Buffer.all); 99 | Button_Changed := False; 100 | end if; 101 | 102 | -- Check for a button being pressed. 103 | UI.Buttons.Get_Event (Buffer => Buffer.all, 104 | Touch => STM32.Board.Touch_Panel, 105 | List => EtherScope.Display.Buttons, 106 | Event => Action); 107 | if Action /= UI.Buttons.NO_EVENT then 108 | Mode := Action; 109 | UI.Buttons.Set_Active (EtherScope.Display.Buttons, Action, Button_Changed); 110 | 111 | -- Update the buttons in the first layer. 112 | if Button_Changed then 113 | EtherScope.Display.Draw_Buttons (Buffer.all); 114 | end if; 115 | end if; 116 | 117 | -- Refresh the display only every 500 ms or when the display state is changed. 118 | if Refresh_Deadline <= Now or Button_Changed then 119 | case Mode is 120 | when EtherScope.Display.B_ETHER => 121 | EtherScope.Display.Display_Devices (Buffer.all); 122 | Graph_Mode := EtherScope.Stats.G_ETHERNET; 123 | 124 | when EtherScope.Display.B_IPv4 => 125 | EtherScope.Display.Display_Protocols (Buffer.all); 126 | Graph_Mode := EtherScope.Stats.G_ETHERNET; 127 | 128 | when EtherScope.Display.B_IGMP => 129 | EtherScope.Display.Display_Groups (Buffer.all); 130 | Graph_Mode := EtherScope.Stats.G_UDP; 131 | 132 | when EtherScope.Display.B_TCP => 133 | EtherScope.Display.Display_TCP (Buffer.all); 134 | Graph_Mode := EtherScope.Stats.G_TCP; 135 | 136 | when others => 137 | null; 138 | 139 | end case; 140 | EtherScope.Display.Refresh_Graphs (Buffer.all, Graph_Mode); 141 | EtherScope.Display.Display_Summary (Buffer.all); 142 | STM32.Board.Display.Update_Layer (1); 143 | Refresh_Deadline := Refresh_Deadline + REFRESH_PERIOD; 144 | end if; 145 | delay until Now + Ada.Real_Time.Milliseconds (100); 146 | end; 147 | end loop; 148 | 149 | end Etheroscope; 150 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-base.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer-base -- Packet analyzer 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Ada.Real_Time; 19 | 20 | with Net.Headers; 21 | with Net.Protos; 22 | package body EtherScope.Analyzer.Base is 23 | 24 | use type Ada.Real_Time.Time; 25 | use type Ada.Real_Time.Time_Span; 26 | use type EtherScope.Stats.Device_Count; 27 | 28 | -- Protect the access of the analysis results between the 29 | -- analyzer's task and the display main task. 30 | protected DB is 31 | procedure Get_Devices (Devices : out Device_Stats); 32 | procedure Get_Protocols (Protocols : out Protocol_Stats); 33 | procedure Get_Groups (Groups : out Group_Stats); 34 | procedure Get_TCP (Ports : out TCP_Stats); 35 | procedure Update_Graph_Samples (Result : out EtherScope.Stats.Graph_Samples; 36 | Clear : in Boolean); 37 | 38 | procedure Analyze_Ethernet (Packet : in out Net.Buffers.Buffer_Type; 39 | Device : out EtherScope.Stats.Device_Index); 40 | 41 | procedure Analyze_IPv4 (Packet : in out Net.Buffers.Buffer_Type; 42 | Device : in EtherScope.Stats.Device_Index); 43 | 44 | private 45 | Deadline : Ada.Real_Time.Time := Ada.Real_Time.Clock; 46 | Prev_Time : Ada.Real_Time.Time := Ada.Real_Time.Clock; 47 | 48 | -- Ethernet information. 49 | Ethernet : EtherScope.Analyzer.Ethernet.Analysis; 50 | Prev_Ethernet : EtherScope.Analyzer.Ethernet.Analysis; 51 | 52 | -- IPv4 analysis. 53 | IPv4 : EtherScope.Analyzer.IPv4.Analysis; 54 | Prev_IPv4 : EtherScope.Analyzer.IPv4.Analysis; 55 | 56 | -- IGMP group analysis. 57 | IGMP_Groups : EtherScope.Analyzer.IGMP.Analysis; 58 | Prev_Groups : EtherScope.Analyzer.IGMP.Analysis; 59 | 60 | -- TCP/IP analysis. 61 | TCP_Ports : EtherScope.Analyzer.TCP.Analysis; 62 | Prev_TCP : EtherScope.Analyzer.TCP.Analysis; 63 | 64 | -- Pending samples for the graphs. 65 | Samples : EtherScope.Stats.Graph_Samples; 66 | end DB; 67 | 68 | ONE_MS : constant Ada.Real_Time.Time_Span := Ada.Real_Time.Milliseconds (1); 69 | 70 | protected body DB is 71 | 72 | procedure Update_Rates is 73 | Now : constant Ada.Real_Time.Time := Ada.Real_Time.Clock; 74 | begin 75 | if Deadline < Now then 76 | declare 77 | Dt : constant Ada.Real_Time.Time_Span := Now - Prev_Time; 78 | MS : constant Integer := Dt / ONE_MS; 79 | begin 80 | EtherScope.Analyzer.Ethernet.Update_Rates (Ethernet, Prev_Ethernet, MS); 81 | EtherScope.Analyzer.IPv4.Update_Rates (IPv4, Prev_IPv4, MS); 82 | EtherScope.Analyzer.IGMP.Update_Rates (IGMP_Groups, Prev_Groups, MS); 83 | EtherScope.Analyzer.TCP.Update_Rates (TCP_Ports, Prev_TCP, MS); 84 | Prev_Time := Now; 85 | Deadline := Deadline + Ada.Real_Time.Seconds (1); 86 | end; 87 | end if; 88 | end Update_Rates; 89 | 90 | procedure Get_Devices (Devices : out Device_Stats) is 91 | begin 92 | Update_Rates; 93 | Devices.Ethernet := Ethernet.Devices; 94 | Devices.IPv4 := IPv4.Devices; 95 | Devices.Count := Ethernet.Dev_Count; 96 | end Get_Devices; 97 | 98 | procedure Get_Protocols (Protocols : out Protocol_Stats) is 99 | begin 100 | Update_Rates; 101 | Protocols.Ethernet := Ethernet.Global; 102 | Protocols.ICMP := IPv4.ICMP; 103 | Protocols.IGMP := IPv4.IGMP; 104 | Protocols.UDP := IPv4.UDP; 105 | Protocols.TCP := IPv4.TCP; 106 | Protocols.Unknown := IPv4.Unknown; 107 | end Get_Protocols; 108 | 109 | procedure Get_Groups (Groups : out Group_Stats) is 110 | begin 111 | Update_Rates; 112 | Groups.Groups := IGMP_Groups.Groups; 113 | Groups.Count := IGMP_Groups.Count; 114 | Groups.IGMP := IPv4.IGMP; 115 | Groups.UDP := IPv4.UDP; 116 | end Get_Groups; 117 | 118 | procedure Get_TCP (Ports : out TCP_Stats) is 119 | begin 120 | Update_Rates; 121 | Ports.Ports := TCP_Ports.Ports; 122 | Ports.Count := TCP_Ports.Count; 123 | Ports.TCP := IPv4.TCP; 124 | end Get_TCP; 125 | 126 | procedure Update_Graph_Samples (Result : out EtherScope.Stats.Graph_Samples; 127 | Clear : in Boolean) is 128 | pragma Unreferenced (Clear); 129 | begin 130 | Result := Samples; 131 | for I in Samples'Range loop 132 | Samples (I) := 0; 133 | end loop; 134 | end Update_Graph_Samples; 135 | 136 | procedure Analyze_Ethernet (Packet : in out Net.Buffers.Buffer_Type; 137 | Device : out EtherScope.Stats.Device_Index) is 138 | Ether : Net.Headers.Ether_Header_Access; 139 | begin 140 | Ether := Packet.Ethernet; 141 | EtherScope.Analyzer.Ethernet.Analyze (Ether, Packet.Get_Length, 142 | Ethernet, Samples, Device); 143 | end Analyze_Ethernet; 144 | 145 | procedure Analyze_IPv4 (Packet : in out Net.Buffers.Buffer_Type; 146 | Device : in EtherScope.Stats.Device_Index) is 147 | begin 148 | EtherScope.Analyzer.IPv4.Analyze (Packet, Device, IPv4, IGMP_Groups, TCP_Ports, Samples); 149 | end Analyze_IPv4; 150 | 151 | end DB; 152 | 153 | -- ------------------------------ 154 | -- Analyze the received packet. 155 | -- ------------------------------ 156 | procedure Analyze (Packet : in out Net.Buffers.Buffer_Type) is 157 | Ether : Net.Headers.Ether_Header_Access; 158 | Device : EtherScope.Stats.Device_Index; 159 | begin 160 | DB.Analyze_Ethernet (Packet, Device); 161 | Ether := Packet.Ethernet; 162 | case Net.Headers.To_Host (Ether.Ether_Type) is 163 | when Net.Protos.ETHERTYPE_ARP => 164 | -- EtherScope.Analyzer.Arp.Analyze (Ether); 165 | null; 166 | 167 | when Net.Protos.ETHERTYPE_IP => 168 | DB.Analyze_IPv4 (Packet, Device); 169 | 170 | when others => 171 | -- EtherScope.Analyzer.Analyze (Ether, Packet); 172 | null; 173 | 174 | end case; 175 | end Analyze; 176 | 177 | -- ------------------------------ 178 | -- Get the device statistics. 179 | -- ------------------------------ 180 | procedure Get_Devices (Into : out Device_Stats) is 181 | begin 182 | DB.Get_Devices (Into); 183 | end Get_Devices; 184 | 185 | -- ------------------------------ 186 | -- Get the protocol statistics. 187 | -- ------------------------------ 188 | procedure Get_Protocols (Into : out Protocol_Stats) is 189 | begin 190 | DB.Get_Protocols (Into); 191 | end Get_Protocols; 192 | 193 | -- ------------------------------ 194 | -- Get the multicast group statistics. 195 | -- ------------------------------ 196 | procedure Get_Groups (Into : out Group_Stats) is 197 | begin 198 | DB.Get_Groups (Into); 199 | end Get_Groups; 200 | 201 | -- ------------------------------ 202 | -- Get the TCP/IP information statistics. 203 | -- ------------------------------ 204 | procedure Get_TCP (Into : out TCP_Stats) is 205 | begin 206 | DB.Get_TCP (Into); 207 | end Get_TCP; 208 | 209 | procedure Update_Graph_Samples (Samples : out EtherScope.Stats.Graph_Samples; 210 | Clear : in Boolean) is 211 | begin 212 | DB.Update_Graph_Samples (Samples, Clear); 213 | end Update_Graph_Samples; 214 | 215 | end EtherScope.Analyzer.Base; 216 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-base.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer-base -- Packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Net.Buffers; 19 | with EtherScope.Stats; 20 | with EtherScope.Analyzer.Ethernet; 21 | with EtherScope.Analyzer.IPv4; 22 | with EtherScope.Analyzer.IGMP; 23 | with EtherScope.Analyzer.TCP; 24 | 25 | -- === Package Analyzer === 26 | -- The packet analyzer looks at the received Ethernet packet and applies protocol 27 | -- specific analysis to gather all the information. It provides entry points for 28 | -- the display task to retrieve the collected data. 29 | -- 30 | -- The analysis is internally protected from concurrency between the receiver's task 31 | -- that uses the Analyze procedure and the display task that uses other 32 | -- operations. 33 | package EtherScope.Analyzer.Base is 34 | 35 | type Device_Stats is record 36 | Count : EtherScope.Stats.Device_Count := 0; 37 | Ethernet : EtherScope.Analyzer.Ethernet.Device_Table_Stats; 38 | IPv4 : EtherScope.Analyzer.IPv4.Device_Table_Stats; 39 | end record; 40 | 41 | type Protocol_Stats is record 42 | Count : EtherScope.Stats.Protocol_Count := 0; 43 | 44 | -- Global ICMP, IGMP, UDP, TCP statistics. 45 | Ethernet : EtherScope.Stats.Statistics; 46 | ICMP : EtherScope.Stats.Statistics; 47 | IGMP : EtherScope.Stats.Statistics; 48 | UDP : EtherScope.Stats.Statistics; 49 | TCP : EtherScope.Stats.Statistics; 50 | Unknown : EtherScope.Stats.Statistics; 51 | end record; 52 | 53 | type Group_Stats is record 54 | Groups : EtherScope.Analyzer.IGMP.Group_Table_Stats; 55 | Count : EtherScope.Stats.Group_Count := 0; 56 | 57 | -- Protocol statistics. 58 | IGMP : EtherScope.Stats.Statistics; 59 | UDP : EtherScope.Stats.Statistics; 60 | end record; 61 | 62 | -- TCP/IP analysis results. 63 | type TCP_Stats is record 64 | Ports : EtherScope.Analyzer.TCP.TCP_Table_Stats; 65 | Count : EtherScope.Stats.Group_Count := 0; 66 | 67 | -- Protocol global statistics. 68 | TCP : EtherScope.Stats.Statistics; 69 | end record; 70 | 71 | -- Analyze the received packet. 72 | procedure Analyze (Packet : in out Net.Buffers.Buffer_Type); 73 | 74 | -- Get the device statistics. 75 | procedure Get_Devices (Into : out Device_Stats); 76 | 77 | -- Get the protocol statistics. 78 | procedure Get_Protocols (Into : out Protocol_Stats); 79 | 80 | -- Get the multicast group statistics. 81 | procedure Get_Groups (Into : out Group_Stats); 82 | 83 | -- Get the TCP/IP information statistics. 84 | procedure Get_TCP (Into : out TCP_Stats); 85 | 86 | procedure Update_Graph_Samples (Samples : out EtherScope.Stats.Graph_Samples; 87 | Clear : in Boolean); 88 | 89 | end EtherScope.Analyzer.Base; 90 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-ethernet.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer -- Packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | 19 | package body EtherScope.Analyzer.Ethernet is 20 | 21 | use type EtherScope.Stats.Device_Count; 22 | 23 | -- ------------------------------ 24 | -- Analyze the packet and update the analysis. 25 | -- ------------------------------ 26 | procedure Analyze (Ether : in Net.Headers.Ether_Header_Access; 27 | Length : in Net.Uint16; 28 | Result : in out Analysis; 29 | Samples : in out EtherScope.Stats.Graph_Samples; 30 | Device : out Device_Index) is 31 | use type Net.Uint16; 32 | use type Net.Uint32; 33 | use type Net.Ether_Addr; 34 | Found : Boolean := False; 35 | begin 36 | EtherScope.Stats.Add (Result.Global, Net.Uint32 (Length)); 37 | 38 | -- Collect information by device/Ethernet address. 39 | for I in 1 .. Result.Dev_Count loop 40 | if Result.Devices (I).Mac = Ether.Ether_Shost then 41 | Device := I; 42 | Found := True; 43 | exit; 44 | end if; 45 | end loop; 46 | if not Found then 47 | if Result.Dev_Count < Device_Index'Last then 48 | Result.Dev_Count := Result.Dev_Count + 1; 49 | Result.Devices (Result.Dev_Count).Mac := Ether.Ether_Shost; 50 | end if; 51 | Device := Result.Dev_Count; 52 | end if; 53 | EtherScope.Stats.Add (Samples, EtherScope.Stats.G_ETHERNET, 54 | Result.Devices (Device).Stats, Net.Uint32 (Length)); 55 | 56 | -- Collect information by Ethernet protocol. 57 | for I in Result.Protocols'Range loop 58 | if Result.Protocols (I).Stats.Packets = 0 then 59 | Result.Protocols (I).Proto := Ether.Ether_Type; 60 | end if; 61 | if Result.Protocols (I).Proto = Ether.Ether_Type or else I = Result.Protocols'Last then 62 | EtherScope.Stats.Add (Result.Protocols (I).Stats, Net.Uint32 (Length)); 63 | exit; 64 | end if; 65 | end loop; 66 | end Analyze; 67 | 68 | -- ------------------------------ 69 | -- Compute the bandwidth utilization for different devices and protocols. 70 | -- ------------------------------ 71 | procedure Update_Rates (Current : in out Analysis; 72 | Previous : in out Analysis; 73 | Dt : in Positive) is 74 | begin 75 | for I in 1 .. Current.Dev_Count loop 76 | if I <= Previous.Dev_Count then 77 | EtherScope.Stats.Update_Rate (Current.Devices (I).Stats, Previous.Devices (I).Stats, Dt); 78 | else 79 | Previous.Devices (I) := Current.Devices (I); 80 | end if; 81 | end loop; 82 | end Update_Rates; 83 | 84 | end EtherScope.Analyzer.Ethernet; 85 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-ethernet.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer-ethernet -- Ethernet packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Net.Headers; 19 | with EtherScope.Stats; 20 | 21 | -- === Ethernet Packet Analyzer === 22 | -- The Ethernet packet analyzer collects the different source Ethernet addresses 23 | -- and different Ethernet types seen in the Ethernet header. The information 24 | -- is collected in two different tables: 25 | -- 26 | -- * A device table keeps a list of devices seen on the network. 27 | -- * A protocol table keeps a list of Ethernet protocols. 28 | -- 29 | -- Both tables have fixed sizes to avoid dynamic memory allocation. 30 | -- New entries are filled in the tables until all the entries are used. 31 | -- The last table entry is used to collect everything that does not fit. 32 | -- 33 | -- The Ethernet packet analyzer computes a device index based on the Ethernet 34 | -- source address. This device index can be used by other protocol analyzers 35 | -- to easily populate their device analysis. 36 | package EtherScope.Analyzer.Ethernet is 37 | 38 | subtype Device_Index is EtherScope.Stats.Device_Index; 39 | 40 | -- Collect per source Ethernet statistics. 41 | type Device_Stats is record 42 | Mac : Net.Ether_Addr; 43 | Stats : EtherScope.Stats.Statistics; 44 | end record; 45 | 46 | type Device_Table_Stats is array (Device_Index) of Device_Stats; 47 | 48 | -- Collect per Ethernet protocol type statistics. 49 | type Protocol_Stats is record 50 | Proto : Net.Uint16 := 0; 51 | Stats : EtherScope.Stats.Statistics; 52 | end record; 53 | 54 | type Protocol_Table_Stats is array (Device_Index) of Protocol_Stats; 55 | 56 | -- Ethernet packet analysis. 57 | type Analysis is record 58 | Devices : Device_Table_Stats; 59 | Dev_Count : EtherScope.Stats.Device_Count := 0; 60 | Protocols : Protocol_Table_Stats; 61 | Pro_Count : EtherScope.Stats.Device_Count := 0; 62 | Global : EtherScope.Stats.Statistics; 63 | end record; 64 | 65 | -- Analyze the packet and update the analysis. 66 | procedure Analyze (Ether : in Net.Headers.Ether_Header_Access; 67 | Length : in Net.Uint16; 68 | Result : in out Analysis; 69 | Samples : in out EtherScope.Stats.Graph_Samples; 70 | Device : out Device_Index); 71 | 72 | -- Compute the bandwidth utilization for different devices and protocols. 73 | procedure Update_Rates (Current : in out Analysis; 74 | Previous : in out Analysis; 75 | Dt : in Positive); 76 | 77 | end EtherScope.Analyzer.Ethernet; 78 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-igmp.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer-igmp -- IGMP packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Net.Headers; 19 | 20 | package body EtherScope.Analyzer.IGMP is 21 | 22 | use type Net.Ip_Addr; 23 | use type EtherScope.Stats.Group_Count; 24 | 25 | -- ------------------------------ 26 | -- Analyze the packet and update the analysis. 27 | -- ------------------------------ 28 | procedure Analyze (Packet : in Net.Buffers.Buffer_Type; 29 | Result : in out Analysis) is 30 | IGMP : constant Net.Headers.IGMP_Header_Access := Packet.IGMP; 31 | begin 32 | case IGMP.Igmp_Type is 33 | when Net.Headers.IGMP_V2_MEMBERSHIP_REPORT 34 | | Net.Headers.IGMP_V3_MEMBERSHIP_REPORT => 35 | for I in 1 .. Result.Count loop 36 | if Result.Groups (I).Ip = IGMP.Igmp_Group then 37 | Result.Groups (I).Report_Count := Result.Groups (I).Report_Count + 1; 38 | Result.Groups (I).Last_Report := Ada.Real_Time.Clock; 39 | return; 40 | end if; 41 | end loop; 42 | if Result.Count = Result.Groups'Last then 43 | return; 44 | end if; 45 | Result.Count := Result.Count + 1; 46 | Result.Groups (Result.Count).Ip := IGMP.Igmp_Group; 47 | Result.Groups (Result.Count).Report_Count := 1; 48 | Result.Groups (Result.Count).Last_Report := Ada.Real_Time.Clock; 49 | 50 | when Net.Headers.IGMP_V2_LEAVE_GROUP => 51 | -- Look for the group and remove the entry. We (incorrectly) assume that 52 | -- there is only one subscriber. 53 | for I in 1 .. Result.Count loop 54 | if Result.Groups (I).Ip = IGMP.Igmp_Group then 55 | if I < Result.Count then 56 | Result.Groups (I .. Result.Count - 1) := Result.Groups (I + 1 .. Result.Count); 57 | end if; 58 | Result.Count := Result.Count - 1; 59 | return; 60 | end if; 61 | end loop; 62 | 63 | when others => 64 | null; 65 | 66 | end case; 67 | end Analyze; 68 | 69 | -- ------------------------------ 70 | -- Analyze the UDP multicast packet and update the analysis. 71 | -- ------------------------------ 72 | procedure Analyze_Traffic (Packet : in Net.Buffers.Buffer_Type; 73 | Result : in out Analysis) is 74 | Ip_Hdr : constant Net.Headers.IP_Header_Access := Packet.IP; 75 | begin 76 | -- Find the multicast group based on the multicast address and update the UDP flow. 77 | for I in 1 .. Result.Count loop 78 | if Result.Groups (I).Ip = Ip_Hdr.Ip_Dst then 79 | EtherScope.Stats.Add (Result.Groups (I).UDP, Net.Uint32 (Packet.Get_Length)); 80 | return; 81 | end if; 82 | end loop; 83 | end Analyze_Traffic; 84 | 85 | -- ------------------------------ 86 | -- Compute the bandwidth utilization for different devices and protocols. 87 | -- ------------------------------ 88 | procedure Update_Rates (Current : in out Analysis; 89 | Previous : in out Analysis; 90 | Dt : in Positive) is 91 | begin 92 | for I in 1 .. Current.Count loop 93 | if I <= Previous.Count then 94 | EtherScope.Stats.Update_Rate (Current.Groups (I).UDP, Previous.Groups (I).UDP, Dt); 95 | else 96 | Previous.Groups (I).UDP := Current.Groups (I).UDP; 97 | end if; 98 | end loop; 99 | Previous.Count := Current.Count; 100 | end Update_Rates; 101 | 102 | end EtherScope.Analyzer.IGMP; 103 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-igmp.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer-igmp -- IGMP packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Ada.Real_Time; 19 | with Net.Buffers; 20 | with EtherScope.Stats; 21 | 22 | -- === IGMP Analysis === 23 | -- The IGMP analysis looks at multicast group submissions and remember which multicast 24 | -- group was subscribed. It also identifies the multicast traffic and associate it to 25 | -- the IGMP group. The analyzer identifies when a host subscribes to a multicast group 26 | -- and when the group is left. 27 | -- 28 | -- The implementation is able to remember only one subscriber. 29 | package EtherScope.Analyzer.IGMP is 30 | 31 | subtype Group_Index is EtherScope.Stats.Group_Index; 32 | 33 | -- Collect per source IGMP group statistics. 34 | type Group_Stats is record 35 | -- The IPv4 group address. 36 | Ip : Net.Ip_Addr := (0, 0, 0, 0); 37 | 38 | -- Time of the last report. 39 | Last_Report : Ada.Real_Time.Time; 40 | 41 | -- Number of membership reports seen so far. 42 | Report_Count : Natural := 0; 43 | 44 | -- UDP flow statistics associated with the group. 45 | UDP : EtherScope.Stats.Statistics; 46 | end record; 47 | 48 | type Group_Table_Stats is array (Group_Index) of Group_Stats; 49 | 50 | -- IGMP packet and associated traffic analysis. 51 | type Analysis is record 52 | Groups : Group_Table_Stats; 53 | Count : EtherScope.Stats.Group_Count := 0; 54 | end record; 55 | 56 | -- Analyze the IGMP packet and update the analysis. 57 | procedure Analyze (Packet : in Net.Buffers.Buffer_Type; 58 | Result : in out Analysis); 59 | 60 | -- Analyze the UDP multicast packet and update the analysis. 61 | procedure Analyze_Traffic (Packet : in Net.Buffers.Buffer_Type; 62 | Result : in out Analysis); 63 | 64 | -- Compute the bandwidth utilization for different devices and protocols. 65 | procedure Update_Rates (Current : in out Analysis; 66 | Previous : in out Analysis; 67 | Dt : in Positive); 68 | 69 | end EtherScope.Analyzer.IGMP; 70 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-ipv4.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer-ipv4 -- IPv4 packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Net.Headers; 19 | with Net.Protos.IPv4; 20 | 21 | package body EtherScope.Analyzer.IPv4 is 22 | 23 | use type EtherScope.Stats.Device_Count; 24 | 25 | -- ------------------------------ 26 | -- Analyze the packet and update the analysis. 27 | -- ------------------------------ 28 | procedure Analyze (Packet : in Net.Buffers.Buffer_Type; 29 | Device : in Device_Index; 30 | Result : in out Analysis; 31 | Groups : in out EtherScope.Analyzer.IGMP.Analysis; 32 | Ports : in out EtherScope.Analyzer.TCP.Analysis; 33 | Samples : in out EtherScope.Stats.Graph_Samples) is 34 | use type Net.Ip_Addr; 35 | 36 | Ip_Hdr : constant Net.Headers.IP_Header_Access := Packet.IP; 37 | Length : constant Net.Uint32 := Net.Uint32 (Packet.Get_Length); 38 | begin 39 | if Result.Devices (Device).Ip /= Ip_Hdr.Ip_Src then 40 | if Device > Result.Count then 41 | Result.Count := Device; 42 | end if; 43 | if Result.Devices (Device).Ip /= (0, 0, 0, 0) then 44 | Result.Devices (Device).Multihome := True; 45 | end if; 46 | Result.Devices (Device).Ip := Ip_Hdr.Ip_Src; 47 | end if; 48 | 49 | -- Collect per IPv4 protocol statistics. 50 | case Ip_Hdr.Ip_P is 51 | when Net.Protos.IPv4.P_UDP => 52 | EtherScope.Stats.Add (Samples, EtherScope.Stats.G_UDP, Result.UDP, Length); 53 | EtherScope.Stats.Add (Result.Devices (Device).UDP, Length); 54 | if Net.Is_Multicast (Ip_Hdr.Ip_Dst) then 55 | EtherScope.Analyzer.IGMP.Analyze_Traffic (Packet, Groups); 56 | end if; 57 | 58 | when Net.Protos.IPv4.P_TCP => 59 | EtherScope.Stats.Add (Samples, EtherScope.Stats.G_TCP, Result.TCP, Length); 60 | EtherScope.Stats.Add (Result.Devices (Device).TCP, Length); 61 | EtherScope.Analyzer.TCP.Analyze (Packet, Ports); 62 | 63 | when Net.Protos.IPv4.P_ICMP => 64 | EtherScope.Stats.Add (Samples, EtherScope.Stats.G_ICMP, Result.ICMP, Length); 65 | EtherScope.Stats.Add (Result.Devices (Device).ICMP, Length); 66 | 67 | when Net.Protos.IPv4.P_IGMP => 68 | EtherScope.Stats.Add (Samples, EtherScope.Stats.G_IGMP, Result.IGMP, Length); 69 | EtherScope.Stats.Add (Result.Devices (Device).IGMP, Length); 70 | EtherScope.Analyzer.IGMP.Analyze (Packet, Groups); 71 | 72 | when others => 73 | EtherScope.Stats.Add (Result.Unknown, Length); 74 | EtherScope.Stats.Add (Result.Devices (Device).Unknown, Length); 75 | 76 | end case; 77 | end Analyze; 78 | 79 | -- ------------------------------ 80 | -- Compute the bandwidth utilization for different devices and protocols. 81 | -- ------------------------------ 82 | procedure Update_Rates (Current : in out Analysis; 83 | Previous : in out Analysis; 84 | Dt : in Positive) is 85 | begin 86 | for I in 1 .. Current.Count loop 87 | if I <= Previous.Count then 88 | EtherScope.Stats.Update_Rate (Current.Devices (I).ICMP, Previous.Devices (I).ICMP, Dt); 89 | EtherScope.Stats.Update_Rate (Current.Devices (I).IGMP, Previous.Devices (I).IGMP, Dt); 90 | EtherScope.Stats.Update_Rate (Current.Devices (I).UDP, Previous.Devices (I).UDP, Dt); 91 | EtherScope.Stats.Update_Rate (Current.Devices (I).TCP, Previous.Devices (I).TCP, Dt); 92 | else 93 | Previous.Devices (I) := Current.Devices (I); 94 | end if; 95 | end loop; 96 | Previous.Count := Current.Count; 97 | 98 | EtherScope.Stats.Update_Rate (Current.ICMP, Previous.ICMP, Dt); 99 | EtherScope.Stats.Update_Rate (Current.IGMP, Previous.IGMP, Dt); 100 | EtherScope.Stats.Update_Rate (Current.UDP, Previous.UDP, Dt); 101 | EtherScope.Stats.Update_Rate (Current.TCP, Previous.TCP, Dt); 102 | EtherScope.Stats.Update_Rate (Current.UDP, Previous.Unknown, Dt); 103 | end Update_Rates; 104 | 105 | end EtherScope.Analyzer.IPv4; 106 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-ipv4.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer-ipv4 -- IPv4 packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Net.Buffers; 19 | with EtherScope.Stats; 20 | with EtherScope.Analyzer.IGMP; 21 | with EtherScope.Analyzer.TCP; 22 | 23 | -- === IPv4 Packet Analyzer === 24 | -- The IPv4 packet analyzer collects the different IPv4 addresses seen on the 25 | -- network. It maintains a table of per-device statistics, the device index is 26 | -- computed by the Ethernet analyzer based on the source Ethernet address. 27 | -- When we detect several IP addresses for the same device, the Multihome flag 28 | -- is set. 29 | -- 30 | -- We also collect global IPv4 protocol statistics. 31 | package EtherScope.Analyzer.IPv4 is 32 | 33 | subtype Device_Index is EtherScope.Stats.Device_Index; 34 | 35 | -- Collect per source IP statistics. 36 | type Device_Stats is record 37 | -- The device IPv4 address. 38 | Ip : Net.Ip_Addr := (0, 0, 0, 0); 39 | 40 | -- Whether we detected several IPv4 addresses for the device. 41 | Multihome : Boolean := False; 42 | 43 | -- ICMP, IGMP, UDP, TCP statistics from packets comming from the device. 44 | ICMP : EtherScope.Stats.Statistics; 45 | IGMP : EtherScope.Stats.Statistics; 46 | UDP : EtherScope.Stats.Statistics; 47 | TCP : EtherScope.Stats.Statistics; 48 | Unknown : EtherScope.Stats.Statistics; 49 | end record; 50 | 51 | type Device_Table_Stats is array (Device_Index) of Device_Stats; 52 | 53 | -- IPv4 packet analysis. 54 | type Analysis is record 55 | Devices : Device_Table_Stats; 56 | Count : EtherScope.Stats.Device_Count := 0; 57 | 58 | -- Global ICMP, IGMP, UDP, TCP statistics. 59 | ICMP : EtherScope.Stats.Statistics; 60 | IGMP : EtherScope.Stats.Statistics; 61 | UDP : EtherScope.Stats.Statistics; 62 | TCP : EtherScope.Stats.Statistics; 63 | Unknown : EtherScope.Stats.Statistics; 64 | end record; 65 | 66 | -- Analyze the packet and update the analysis. 67 | procedure Analyze (Packet : in Net.Buffers.Buffer_Type; 68 | Device : in Device_Index; 69 | Result : in out Analysis; 70 | Groups : in out EtherScope.Analyzer.IGMP.Analysis; 71 | Ports : in out EtherScope.Analyzer.TCP.Analysis; 72 | Samples : in out EtherScope.Stats.Graph_Samples); 73 | 74 | -- Compute the bandwidth utilization for different devices and protocols. 75 | procedure Update_Rates (Current : in out Analysis; 76 | Previous : in out Analysis; 77 | Dt : in Positive); 78 | 79 | end EtherScope.Analyzer.IPv4; 80 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-tcp.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer-tcp -- TCP/IP packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Net.Headers; 19 | 20 | package body EtherScope.Analyzer.TCP is 21 | 22 | use type Net.Uint16; 23 | use type Net.Ip_Addr; 24 | use type EtherScope.Stats.Group_Count; 25 | 26 | -- ------------------------------ 27 | -- Analyze the packet and update the analysis. 28 | -- ------------------------------ 29 | procedure Analyze (Packet : in Net.Buffers.Buffer_Type; 30 | Result : in out Analysis) is 31 | TCP : constant Net.Headers.TCP_Header_Access := Packet.TCP; 32 | Sport : constant Net.Uint16 := Net.Headers.To_Host (TCP.Th_Sport); 33 | Dport : constant Net.Uint16 := Net.Headers.To_Host (TCP.Th_Dport); 34 | Port : constant Net.Uint16 := (if Sport < Dport then Sport else Dport); 35 | begin 36 | for I in 1 .. Result.Count loop 37 | if Result.Ports (I).Port = Port then 38 | EtherScope.Stats.Add (Result.Ports (I).TCP, Net.Uint32 (Packet.Get_Length)); 39 | return; 40 | end if; 41 | end loop; 42 | if Result.Count = Result.Ports'Last or (Port > 1024 and Port /= 8080) then 43 | return; 44 | end if; 45 | Result.Count := Result.Count + 1; 46 | Result.Ports (Result.Count).Port := Port; 47 | EtherScope.Stats.Add (Result.Ports (Result.Count).TCP, Net.Uint32 (Packet.Get_Length)); 48 | end Analyze; 49 | 50 | -- ------------------------------ 51 | -- Compute the bandwidth utilization for different devices and protocols. 52 | -- ------------------------------ 53 | procedure Update_Rates (Current : in out Analysis; 54 | Previous : in out Analysis; 55 | Dt : in Positive) is 56 | begin 57 | for I in 1 .. Current.Count loop 58 | if I <= Previous.Count then 59 | EtherScope.Stats.Update_Rate (Current.Ports (I).TCP, Previous.Ports (I).TCP, Dt); 60 | else 61 | Previous.Ports (I).TCP := Current.Ports (I).TCP; 62 | end if; 63 | end loop; 64 | Previous.Count := Current.Count; 65 | end Update_Rates; 66 | 67 | end EtherScope.Analyzer.TCP; 68 | -------------------------------------------------------------------------------- /src/etherscope-analyzer-tcp.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer-tcp -- TCP/IP packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Net.Buffers; 19 | with EtherScope.Stats; 20 | 21 | -- === TCP/IP Analysis === 22 | -- The TCP/IP analysis inspects the TCP header and collects information about source 23 | -- and destination ports to classify the traffic in higher level protocols such 24 | -- as ''http'', ''https'' or ''ssh''. 25 | -- 26 | package EtherScope.Analyzer.TCP is 27 | 28 | subtype Group_Index is EtherScope.Stats.Group_Index; 29 | 30 | -- Collect per source IGMP group statistics. 31 | type TCP_Stats is record 32 | -- The server's TCP/IP port. 33 | Port : Net.Uint16 := 0; 34 | 35 | -- TCP flow statistics associated with the port. 36 | TCP : EtherScope.Stats.Statistics; 37 | end record; 38 | 39 | type TCP_Table_Stats is array (Group_Index) of TCP_Stats; 40 | 41 | -- TCP/IP packet and associated traffic analysis. 42 | type Analysis is record 43 | Ports : TCP_Table_Stats; 44 | Count : EtherScope.Stats.Group_Count := 0; 45 | end record; 46 | 47 | -- Analyze the TCP packet and update the analysis. 48 | procedure Analyze (Packet : in Net.Buffers.Buffer_Type; 49 | Result : in out Analysis); 50 | 51 | -- Compute the bandwidth utilization for different TCP/IP protocols. 52 | procedure Update_Rates (Current : in out Analysis; 53 | Previous : in out Analysis; 54 | Dt : in Positive); 55 | 56 | end EtherScope.Analyzer.TCP; 57 | -------------------------------------------------------------------------------- /src/etherscope-analyzer.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-analyzer -- Packet analyzer 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | 19 | -- == EtherScope Analyzer == 20 | -- The packet analysis is split in different parts depending on the protocol 21 | -- identified on the packet. Each protocol analyzer collects its own information 22 | -- in some Analysis record. Some protocol analyzer also rely on the 23 | -- analysis of another protocol. 24 | -- 25 | -- @include etherscope-analyzer-base.ads 26 | -- @include etherscope-analyzer-ethernet.ads 27 | -- @include etherscope-analyzer-ipv4.ads 28 | -- @include etherscope-analyzer-igmp.ads 29 | -- @include etherscope-analyzer-tcp.ads 30 | package EtherScope.Analyzer is 31 | 32 | end EtherScope.Analyzer; 33 | -------------------------------------------------------------------------------- /src/etherscope-display.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-display -- Display manager 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Ada.Real_Time; 19 | 20 | with STM32.Board; 21 | with Bitmapped_Drawing; 22 | with BMP_Fonts; 23 | with Interfaces; 24 | with Net.Utils; 25 | with UI.Texts; 26 | 27 | with EtherScope.Analyzer.Ethernet; 28 | with EtherScope.Analyzer.IPv4; 29 | with EtherScope.Analyzer.IGMP; 30 | with EtherScope.Analyzer.TCP; 31 | with EtherScope.Analyzer.Base; 32 | with EtherScope.Receiver; 33 | 34 | package body EtherScope.Display is 35 | 36 | use type Interfaces.Unsigned_32; 37 | use type Interfaces.Unsigned_64; 38 | use UI.Texts; 39 | use type Net.Uint16; 40 | 41 | -- Convert the integer to a string without a leading space. 42 | function Image (Value : in Net.Uint32) return String; 43 | function Image (Value : in Net.Uint64) return String; 44 | function Format_Packets (Value : in Net.Uint32) return String; 45 | function Format_Bytes (Value : in Net.Uint64) return String; 46 | function Format_Bandwidth (Value : in Net.Uint32) return String; 47 | 48 | -- Kb, Mb, Gb units. 49 | KB : constant Net.Uint64 := 1024; 50 | MB : constant Net.Uint64 := KB * KB; 51 | GB : constant Net.Uint64 := MB * MB; 52 | 53 | Devices : Analyzer.Base.Device_Stats; 54 | Protocols : Analyzer.Base.Protocol_Stats; 55 | Groups : Analyzer.Base.Group_Stats; 56 | TCP_Ports : Analyzer.Base.TCP_Stats; 57 | 58 | -- Convert the integer to a string without a leading space. 59 | function Image (Value : in Net.Uint32) return String is 60 | Result : constant String := Net.Uint32'Image (Value); 61 | begin 62 | return Result (Result'First + 1 .. Result'Last); 63 | end Image; 64 | 65 | function Image (Value : in Net.Uint64) return String is 66 | Result : constant String := Net.Uint64'Image (Value); 67 | begin 68 | return Result (Result'First + 1 .. Result'Last); 69 | end Image; 70 | 71 | function Format_Packets (Value : in Net.Uint32) return String is 72 | begin 73 | return Net.Uint32'Image (Value); 74 | end Format_Packets; 75 | 76 | function Format_Bytes (Value : in Net.Uint64) return String is 77 | begin 78 | if Value < 10 * KB then 79 | return Image (Net.Uint32 (Value)); 80 | elsif Value < 10 * MB then 81 | return Image (Value / KB) & "." & Image (((Value mod KB) * 10) / KB) & "Kb"; 82 | elsif Value < 10 * GB then 83 | return Image (Value / MB) & "." & Image (((Value mod MB) * 10) / MB) & "Mb"; 84 | else 85 | return Image (Value / GB) & "." & Image (((Value mod GB) * 10) / GB) & "Gb"; 86 | end if; 87 | end Format_Bytes; 88 | 89 | function Format_Bandwidth (Value : in Net.Uint32) return String is 90 | begin 91 | if Value < Net.Uint32 (KB) then 92 | return Image (Value); 93 | elsif Value < Net.Uint32 (MB) then 94 | return Image (Value / Net.Uint32 (KB)) & "." 95 | & Image (((Value mod Net.Uint32 (KB)) * 10) / Net.Uint32 (KB)) & "Kbs"; 96 | else 97 | return Image (Value / Net.Uint32 (MB)) & "." 98 | & Image (((Value mod Net.Uint32 (MB)) * 10) / Net.Uint32 (MB)) & "Mbs"; 99 | end if; 100 | end Format_Bandwidth; 101 | 102 | -- ------------------------------ 103 | -- Initialize the display. 104 | -- ------------------------------ 105 | procedure Initialize is 106 | begin 107 | STM32.Board.Display.Initialize; 108 | STM32.Board.Display.Initialize_Layer (1, HAL.Bitmap.ARGB_1555); 109 | 110 | -- Initialize touch panel 111 | STM32.Board.Touch_Panel.Initialize; 112 | 113 | for I in Graphs'Range loop 114 | EtherScope.Display.Use_Graph.Initialize (Graphs (I), 115 | X => 100, 116 | Y => 200, 117 | Width => 380, 118 | Height => 72, 119 | Rate => Ada.Real_Time.Milliseconds (1000)); 120 | end loop; 121 | end Initialize; 122 | 123 | -- ------------------------------ 124 | -- Draw the layout presentation frame. 125 | -- ------------------------------ 126 | procedure Draw_Frame (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class) is 127 | begin 128 | Buffer.Set_Source (UI.Texts.Background); 129 | Buffer.Fill; 130 | Draw_Buttons (Buffer); 131 | Buffer.Set_Source (Line_Color); 132 | Buffer.Draw_Vertical_Line (Pt => (98, 0), 133 | Height => Buffer.Height); 134 | end Draw_Frame; 135 | 136 | -- ------------------------------ 137 | -- Draw the display buttons. 138 | -- ------------------------------ 139 | procedure Draw_Buttons (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class) is 140 | begin 141 | UI.Buttons.Draw_Buttons (Buffer => Buffer, 142 | List => Buttons, 143 | X => 0, 144 | Y => 0, 145 | Width => 95, 146 | Height => 34); 147 | end Draw_Buttons; 148 | 149 | -- ------------------------------ 150 | -- Refresh the graph and draw it. 151 | -- ------------------------------ 152 | procedure Refresh_Graphs (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 153 | Graph_Mode : in EtherScope.Stats.Graph_Kind) is 154 | Now : constant Ada.Real_Time.Time := Ada.Real_Time.Clock; 155 | Samples : EtherScope.Stats.Graph_Samples; 156 | begin 157 | EtherScope.Analyzer.Base.Update_Graph_Samples (Samples, True); 158 | for I in Samples'Range loop 159 | Use_Graph.Add_Sample (Graphs (I), Samples (I), Now); 160 | end loop; 161 | Use_Graph.Draw (Buffer, Graphs (Graph_Mode)); 162 | end Refresh_Graphs; 163 | 164 | -- ------------------------------ 165 | -- Display devices found on the network. 166 | -- ------------------------------ 167 | procedure Display_Devices (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class) is 168 | use EtherScope.Analyzer.Base; 169 | 170 | Y : Natural := 15; 171 | begin 172 | EtherScope.Analyzer.Base.Get_Devices (Devices); 173 | Buffer.Set_Source (UI.Texts.Background); 174 | Buffer.Fill_Rect (Area => (Position => (100, 0), 175 | Width => Buffer.Width - 100, 176 | Height => Buffer.Height)); 177 | for I in 1 .. Devices.Count loop 178 | declare 179 | Ethernet : EtherScope.Analyzer.Ethernet.Device_Stats renames Devices.Ethernet (I); 180 | IP : EtherScope.Analyzer.IPv4.Device_Stats renames Devices.IPv4 (I); 181 | begin 182 | UI.Texts.Draw_String (Buffer, (100, Y), 200, Net.Utils.To_String (Ethernet.Mac)); 183 | UI.Texts.Draw_String (Buffer, (300, Y), 150, Net.Utils.To_String (IP.Ip), RIGHT); 184 | UI.Texts.Draw_String (Buffer, (100, Y + 20), 100, Format_Packets (Ethernet.Stats.Packets), RIGHT); 185 | UI.Texts.Draw_String (Buffer, (200, Y + 20), 200, Format_Bytes (Ethernet.Stats.Bytes), RIGHT); 186 | UI.Texts.Draw_String (Buffer, (400, Y + 20), 80, Format_Bandwidth (Ethernet.Stats.Bandwidth)); 187 | end; 188 | Buffer.Set_Source (Line_Color); 189 | Buffer.Draw_Horizontal_Line (Pt => (100, Y + 45), 190 | Width => Buffer.Width - 100); 191 | Y := Y + 50; 192 | exit when Y + 60 >= Buffer.Height; 193 | end loop; 194 | end Display_Devices; 195 | 196 | -- ------------------------------ 197 | -- Display devices found on the network. 198 | -- ------------------------------ 199 | procedure Display_Protocols (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class) is 200 | use EtherScope.Analyzer.Base; 201 | procedure Display_Protocol (Name : in String; 202 | Stat : in EtherScope.Stats.Statistics); 203 | 204 | Y : Natural := 0; 205 | 206 | procedure Display_Protocol (Name : in String; 207 | Stat : in EtherScope.Stats.Statistics) is 208 | begin 209 | UI.Texts.Draw_String (Buffer, (100, Y), 150, Name); 210 | UI.Texts.Draw_String (Buffer, (150, Y), 100, Format_Packets (Stat.Packets), RIGHT); 211 | UI.Texts.Draw_String (Buffer, (250, Y), 100, Format_Bytes (Stat.Bytes), RIGHT); 212 | UI.Texts.Draw_String (Buffer, (350, Y), 100, Format_Bandwidth (Stat.Bandwidth), RIGHT); 213 | Buffer.Set_Source (Line_Color); 214 | Buffer.Draw_Horizontal_Line (Pt => (100, Y + 23), 215 | Width => Buffer.Width - 100); 216 | Y := Y + 30; 217 | end Display_Protocol; 218 | 219 | begin 220 | EtherScope.Analyzer.Base.Get_Protocols (Protocols); 221 | Buffer.Set_Source (UI.Texts.Background); 222 | Buffer.Fill_Rect (Area => (Position => (100, 0), 223 | Width => Buffer.Width - 100, 224 | Height => Buffer.Height)); 225 | 226 | -- Draw some column header. 227 | UI.Texts.Draw_String (Buffer, (100, Y), 150, "Protocol"); 228 | UI.Texts.Draw_String (Buffer, (150, Y), 100, "Packets", RIGHT); 229 | UI.Texts.Draw_String (Buffer, (250, Y), 100, "Bytes", RIGHT); 230 | UI.Texts.Draw_String (Buffer, (350, Y), 100, "BW", RIGHT); 231 | Buffer.Set_Source (Line_Color); 232 | Buffer.Draw_Horizontal_Line (Pt => (100, Y + 14), 233 | Width => Buffer.Width - 100); 234 | Y := Y + 18; 235 | 236 | UI.Texts.Foreground := HAL.Bitmap.Green; 237 | Display_Protocol ("ICMP", Protocols.ICMP); 238 | Display_Protocol ("IGMP", Protocols.IGMP); 239 | Display_Protocol ("UDP", Protocols.UDP); 240 | Display_Protocol ("TCP", Protocols.TCP); 241 | 242 | Display_Protocol ("Others", Protocols.Unknown); 243 | UI.Texts.Foreground := HAL.Bitmap.White; 244 | end Display_Protocols; 245 | 246 | -- ------------------------------ 247 | -- Display IGMP groups found on the network. 248 | -- ------------------------------ 249 | procedure Display_Groups (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class) is 250 | use EtherScope.Analyzer.Base; 251 | procedure Display_Group (Group : in EtherScope.Analyzer.IGMP.Group_Stats); 252 | 253 | Y : Natural := 0; 254 | 255 | procedure Display_Group (Group : in EtherScope.Analyzer.IGMP.Group_Stats) is 256 | begin 257 | UI.Texts.Draw_String (Buffer, (105, Y), 175, Net.Utils.To_String (Group.Ip)); 258 | UI.Texts.Draw_String (Buffer, (180, Y + 30), 100, Format_Packets (Group.UDP.Packets), RIGHT); 259 | UI.Texts.Draw_String (Buffer, (280, Y + 30), 100, Format_Bytes (Group.UDP.Bytes), RIGHT); 260 | UI.Texts.Draw_String (Buffer, (380, Y), 100, Format_Bandwidth (Group.UDP.Bandwidth), RIGHT); 261 | Buffer.Set_Source (Line_Color); 262 | Buffer.Draw_Horizontal_Line (Pt => (100, Y + 55), 263 | Width => Buffer.Width - 100); 264 | Y := Y + 60; 265 | end Display_Group; 266 | 267 | begin 268 | EtherScope.Analyzer.Base.Get_Groups (Groups); 269 | Buffer.Set_Source (UI.Texts.Background); 270 | Buffer.Fill_Rect (Area => (Position => (100, 0), 271 | Width => Buffer.Width - 100, 272 | Height => Buffer.Height)); 273 | 274 | -- Draw some column header. 275 | UI.Texts.Draw_String (Buffer, (105, Y), 175, "IP"); 276 | UI.Texts.Draw_String (Buffer, (180, Y), 100, "Packets", RIGHT); 277 | UI.Texts.Draw_String (Buffer, (280, Y), 100, "Bytes", RIGHT); 278 | UI.Texts.Draw_String (Buffer, (380, Y), 100, "Bandwidth", RIGHT); 279 | Buffer.Set_Source (Line_Color); 280 | Buffer.Draw_Horizontal_Line (Pt => (100, Y + 14), 281 | Width => Buffer.Width - 100); 282 | Y := Y + 18; 283 | 284 | UI.Texts.Foreground := HAL.Bitmap.Green; 285 | for I in 1 .. Groups.Count loop 286 | Display_Group (Groups.Groups (I)); 287 | exit when Y + 60 >= Buffer.Height; 288 | end loop; 289 | UI.Texts.Foreground := HAL.Bitmap.White; 290 | end Display_Groups; 291 | 292 | -- ------------------------------ 293 | -- Display TCP/IP information found on the network. 294 | -- ------------------------------ 295 | procedure Display_TCP (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class) is 296 | use EtherScope.Analyzer.Base; 297 | procedure Display_Port (Port : in EtherScope.Analyzer.TCP.TCP_Stats); 298 | 299 | Y : Natural := 0; 300 | 301 | procedure Display_Port (Port : in EtherScope.Analyzer.TCP.TCP_Stats) is 302 | begin 303 | -- Ok, this is a simple port lookup conversion! 304 | if Port.Port = 80 then 305 | UI.Texts.Draw_String (Buffer, (105, Y), 175, "http"); 306 | elsif Port.Port = 25 then 307 | UI.Texts.Draw_String (Buffer, (105, Y), 175, "smtp"); 308 | elsif Port.Port = 443 then 309 | UI.Texts.Draw_String (Buffer, (105, Y), 175, "https"); 310 | elsif Port.Port = 22 then 311 | UI.Texts.Draw_String (Buffer, (105, Y), 175, "ssh"); 312 | else 313 | UI.Texts.Draw_String (Buffer, (105, Y), 175, Image (Net.Uint32 (Port.Port))); 314 | end if; 315 | UI.Texts.Draw_String (Buffer, (180, Y), 100, Format_Packets (Port.TCP.Packets), RIGHT); 316 | UI.Texts.Draw_String (Buffer, (280, Y), 100, Format_Bytes (Port.TCP.Bytes), RIGHT); 317 | UI.Texts.Draw_String (Buffer, (380, Y), 100, Format_Bandwidth (Port.TCP.Bandwidth), RIGHT); 318 | Buffer.Set_Source (Line_Color); 319 | Buffer.Draw_Horizontal_Line (Pt => (100, Y + 25), 320 | Width => Buffer.Width - 100); 321 | Y := Y + 30; 322 | end Display_Port; 323 | 324 | begin 325 | EtherScope.Analyzer.Base.Get_TCP (TCP_Ports); 326 | Buffer.Set_Source (UI.Texts.Background); 327 | Buffer.Fill_Rect (Area => (Position => (100, 0), 328 | Width => Buffer.Width - 100, 329 | Height => Buffer.Height)); 330 | 331 | -- Draw some column header. 332 | UI.Texts.Draw_String (Buffer, (105, Y), 175, "TCP Port"); 333 | UI.Texts.Draw_String (Buffer, (180, Y), 100, "Packets", RIGHT); 334 | UI.Texts.Draw_String (Buffer, (280, Y), 100, "Bytes", RIGHT); 335 | UI.Texts.Draw_String (Buffer, (380, Y), 100, "Bandwidth", RIGHT); 336 | Buffer.Set_Source (Line_Color); 337 | Buffer.Draw_Horizontal_Line (Pt => (100, Y + 14), 338 | Width => Buffer.Width - 100); 339 | Y := Y + 18; 340 | 341 | UI.Texts.Foreground := HAL.Bitmap.Green; 342 | UI.Texts.Draw_String (Buffer, (105, Y), 175, "All"); 343 | UI.Texts.Draw_String (Buffer, (180, Y), 100, Format_Packets (TCP_Ports.TCP.Packets), RIGHT); 344 | UI.Texts.Draw_String (Buffer, (280, Y), 100, Format_Bytes (TCP_Ports.TCP.Bytes), RIGHT); 345 | UI.Texts.Draw_String (Buffer, (380, Y), 100, Format_Bandwidth (TCP_Ports.TCP.Bandwidth), RIGHT); 346 | 347 | Buffer.Set_Source (Line_Color); 348 | Buffer.Draw_Horizontal_Line (Pt => (100, 25), 349 | Width => Buffer.Width - 100); 350 | Y := Y + 30; 351 | 352 | for I in 1 .. TCP_Ports.Count loop 353 | Display_Port (TCP_Ports.Ports (I)); 354 | exit when Y + 30 >= Buffer.Height; 355 | end loop; 356 | UI.Texts.Foreground := HAL.Bitmap.White; 357 | end Display_TCP; 358 | 359 | use Ada.Real_Time; 360 | Prev_Time : Ada.Real_Time.Time := Ada.Real_Time.Clock; 361 | Deadline : Ada.Real_Time.Time := Prev_Time + Ada.Real_Time.Seconds (1); 362 | Speed : Net.Uint32 := 0; 363 | Bandwidth : Natural := 0; 364 | Pkts : Net.Uint32 := 0; 365 | Bytes : Net.Uint64 := 0; 366 | ONE_MS : constant Ada.Real_Time.Time_Span := Ada.Real_Time.Milliseconds (1); 367 | 368 | -- ------------------------------ 369 | -- Display a performance summary indicator. 370 | -- ------------------------------ 371 | procedure Display_Summary (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class) is 372 | Now : constant Ada.Real_Time.Time := Ada.Real_Time.Clock; 373 | Cur_Pkts : Net.Uint32; 374 | Cur_Bytes : Net.Uint64; 375 | D : Net.Uint32; 376 | C : Net.Uint32; 377 | begin 378 | if Deadline < Now then 379 | Cur_Bytes := EtherScope.Receiver.Ifnet.Rx_Stats.Bytes; 380 | Cur_Pkts := EtherScope.Receiver.Ifnet.Rx_Stats.Packets; 381 | C := Net.Uint32 ((Now - Prev_Time) / ONE_MS); 382 | D := Net.Uint32 (Cur_Pkts - Pkts); 383 | Speed := Net.Uint32 (D * 1000) / C; 384 | Bandwidth := Natural (((Cur_Bytes - Bytes) * 8000) / Net.Uint64 (C)); 385 | Prev_Time := Now; 386 | Deadline := Deadline + Ada.Real_Time.Seconds (1); 387 | Pkts := Cur_Pkts; 388 | Bytes := Cur_Bytes; 389 | end if; 390 | Buffer.Set_Source (UI.Texts.Background); 391 | Buffer.Fill_Rect (Area => (Position => (0, 160), 392 | Width => 99, 393 | Height => Buffer.Height - 160)); 394 | 395 | Bitmapped_Drawing.Draw_String 396 | (Buffer, 397 | Start => (3, 220), 398 | Msg => "pkts/s", 399 | Font => BMP_Fonts.Font12x12, 400 | Foreground => UI.Texts.Foreground, 401 | Background => UI.Texts.Background); 402 | 403 | Bitmapped_Drawing.Draw_String 404 | (Buffer, 405 | Start => (3, 160), 406 | Msg => "bps", 407 | Font => BMP_Fonts.Font12x12, 408 | Foreground => UI.Texts.Foreground, 409 | Background => UI.Texts.Background); 410 | 411 | Bitmapped_Drawing.Draw_String 412 | (Buffer, 413 | Start => (0, 250), 414 | Msg => Image (Speed), 415 | Font => BMP_Fonts.Font16x24, 416 | Foreground => UI.Texts.Foreground, 417 | Background => UI.Texts.Background); 418 | 419 | Bitmapped_Drawing.Draw_String 420 | (Buffer, 421 | Start => (0, 180), 422 | Msg => Format_Bandwidth (Interfaces.Unsigned_32 (Bandwidth)), 423 | Font => BMP_Fonts.Font16x24, 424 | Foreground => UI.Texts.Foreground, 425 | Background => UI.Texts.Background); 426 | end Display_Summary; 427 | 428 | end EtherScope.Display; 429 | -------------------------------------------------------------------------------- /src/etherscope-display.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-display -- Display manager 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with HAL.Bitmap; 19 | 20 | with Net; 21 | 22 | with UI.Buttons; 23 | with UI.Graphs; 24 | with EtherScope.Stats; 25 | package EtherScope.Display is 26 | 27 | -- Color to draw a separation line. 28 | Line_Color : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.Blue; 29 | 30 | B_ETHER : constant UI.Buttons.Button_Index := 1; 31 | B_IPv4 : constant UI.Buttons.Button_Index := 2; 32 | B_IGMP : constant UI.Buttons.Button_Index := 3; 33 | -- B_ICMP : constant UI.Buttons.Button_Index := 4; 34 | -- B_UDP : constant UI.Buttons.Button_Index := 5; 35 | B_TCP : constant UI.Buttons.Button_Index := 4; 36 | 37 | Buttons : UI.Buttons.Button_Array (B_ETHER .. B_TCP) := 38 | (B_ETHER => (Name => "Ether", State => UI.Buttons.B_PRESSED, others => <>), 39 | B_IPv4 => (Name => "Proto", others => <>), 40 | -- B_ICMP => (Name => "ICMP ", others => <>), 41 | B_IGMP => (Name => "IGMP ", others => <>), 42 | -- B_UDP => (Name => "UDP ", others => <>), 43 | B_TCP => (Name => "TCP ", others => <>)); 44 | 45 | package Use_Graph is new UI.Graphs (Value_Type => Net.Uint64, 46 | Graph_Size => 1024); 47 | subtype Graph_Type is Use_Graph.Graph_Type; 48 | 49 | type Graph_Array is array (EtherScope.Stats.Graph_Kind) of Graph_Type; 50 | 51 | Graphs : Graph_Array; 52 | 53 | -- Initialize the display. 54 | procedure Initialize; 55 | 56 | -- Draw the layout presentation frame. 57 | procedure Draw_Frame (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class); 58 | 59 | -- Draw the display buttons. 60 | procedure Draw_Buttons (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class); 61 | 62 | -- Refresh the graph and draw it. 63 | procedure Refresh_Graphs (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 64 | Graph_Mode : in EtherScope.Stats.Graph_Kind); 65 | 66 | -- Display devices found on the network. 67 | procedure Display_Devices (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class); 68 | 69 | -- Display devices found on the network. 70 | procedure Display_Protocols (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class); 71 | 72 | -- Display TCP/IP information found on the network. 73 | procedure Display_TCP (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class); 74 | 75 | -- Display IGMP groups found on the network. 76 | procedure Display_Groups (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class); 77 | 78 | -- Display a performance summary indicator. 79 | procedure Display_Summary (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class); 80 | 81 | end EtherScope.Display; 82 | -------------------------------------------------------------------------------- /src/etherscope-receiver.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-receiver -- Ethernet Packet Receiver 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Ada.Real_Time; 19 | with Ada.Synchronous_Task_Control; 20 | with Net.Buffers; 21 | with Net.Interfaces; 22 | with EtherScope.Analyzer.Base; 23 | 24 | package body EtherScope.Receiver is 25 | 26 | Ready : Ada.Synchronous_Task_Control.Suspension_Object; 27 | 28 | -- ------------------------------ 29 | -- Start the receiver loop. 30 | -- ------------------------------ 31 | procedure Start is 32 | begin 33 | Ada.Synchronous_Task_Control.Set_True (Ready); 34 | end Start; 35 | 36 | -- ------------------------------ 37 | -- The task that waits for packets. 38 | -- ------------------------------ 39 | task body Controller is 40 | use type Ada.Real_Time.Time; 41 | 42 | Packet : Net.Buffers.Buffer_Type; 43 | begin 44 | -- Wait until the Ethernet driver is ready. 45 | Ada.Synchronous_Task_Control.Suspend_Until_True (Ready); 46 | 47 | Net.Buffers.Allocate (Packet); 48 | loop 49 | Ifnet.Receive (Packet); 50 | EtherScope.Analyzer.Base.Analyze (Packet); 51 | end loop; 52 | end Controller; 53 | 54 | end EtherScope.Receiver; 55 | -------------------------------------------------------------------------------- /src/etherscope-receiver.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-receiver -- Ethernet Packet Receiver 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with System; 19 | with Net.Interfaces.STM32; 20 | package EtherScope.Receiver is 21 | 22 | -- The Ethernet interface driver. 23 | Ifnet : Net.Interfaces.STM32.STM32_Ifnet; 24 | 25 | -- Start the receiver loop. 26 | procedure Start; 27 | 28 | -- The task that waits for packets. 29 | task Controller with 30 | Storage_Size => (16 * 1024), 31 | Priority => System.Default_Priority; 32 | 33 | end EtherScope.Receiver; 34 | -------------------------------------------------------------------------------- /src/etherscope-stats.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-stats -- Ethernet Packet Statistics 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | package body EtherScope.Stats is 19 | 20 | use type Net.Uint32; 21 | use type Net.Uint64; 22 | 23 | -- ------------------------------ 24 | -- Update the statistics after reception of a packet of the given length. 25 | -- ------------------------------ 26 | procedure Add (Stats : in out Statistics; 27 | Length : in Net.Uint32) is 28 | begin 29 | Stats.Packets := Stats.Packets + 1; 30 | Stats.Bytes := Stats.Bytes + Net.Uint64 (Length); 31 | end Add; 32 | 33 | -- ------------------------------ 34 | -- Update the statistics after reception of a packet of the given length. 35 | -- ------------------------------ 36 | procedure Add (Samples : in out Graph_Samples; 37 | Kind : in Graph_Kind; 38 | Stats : in out Statistics; 39 | Length : in Net.Uint32) is 40 | begin 41 | Stats.Packets := Stats.Packets + 1; 42 | Stats.Bytes := Stats.Bytes + Net.Uint64 (Length); 43 | Samples (Kind) := Samples (Kind) + Net.Uint64 (Length); 44 | end Add; 45 | 46 | -- ------------------------------ 47 | -- Compute the bandwidth utilization in bits per second. The Dt is the 48 | -- delta time in milliseconds that ellapsed between the two samples. After the 49 | -- call, Previous contains the same value as Current. 50 | -- ------------------------------ 51 | procedure Update_Rate (Current : in out Statistics; 52 | Previous : in out Statistics; 53 | Dt : in Positive) is 54 | D : constant Net.Uint64 := Current.Bytes - Previous.Bytes; 55 | begin 56 | if D /= 0 then 57 | Current.Bandwidth := Net.Uint32 ((8_000 * D) / Net.Uint64 (Dt)); 58 | else 59 | Current.Bandwidth := 0; 60 | end if; 61 | Previous := Current; 62 | end Update_Rate; 63 | 64 | end EtherScope.Stats; 65 | -------------------------------------------------------------------------------- /src/etherscope-stats.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope-stats -- Ethernet Packet Statistics 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Net; 19 | package EtherScope.Stats is 20 | 21 | -- Device count and index types. 22 | type Device_Count is new Natural range 0 .. 5; 23 | subtype Device_Index is Device_Count range 1 .. Device_Count'Last; 24 | 25 | -- Protocol count and index types. 26 | type Protocol_Count is new Natural range 0 .. 10; 27 | subtype Protocol_Index is Protocol_Count range 1 .. Protocol_Count'Last; 28 | 29 | -- IGMP group count and index types. 30 | type Group_Count is new Natural range 0 .. 5; 31 | subtype Group_Index is Group_Count range 1 .. Group_Count'Last; 32 | 33 | type Graph_Kind is (G_ETHERNET, 34 | G_IPv4, 35 | G_ICMP, 36 | G_IGMP, 37 | G_UDP, 38 | G_TCP); 39 | 40 | type Graph_Samples is array (Graph_Kind) of Net.Uint64; 41 | 42 | type Statistics is record 43 | -- Number of packets seen. 44 | Packets : Net.Uint32 := 0; 45 | 46 | -- Number of bytes seen. 47 | Bytes : Net.Uint64 := 0; 48 | 49 | -- Bandwidth utilization in bits/sec. 50 | Bandwidth : Net.Uint32 := 0; 51 | end record; 52 | 53 | -- Update the statistics after reception of a packet of the given length. 54 | procedure Add (Stats : in out Statistics; 55 | Length : in Net.Uint32); 56 | 57 | -- Update the statistics after reception of a packet of the given length. 58 | procedure Add (Samples : in out Graph_Samples; 59 | Kind : in Graph_Kind; 60 | Stats : in out Statistics; 61 | Length : in Net.Uint32); 62 | 63 | -- Compute the bandwidth utilization in bits per second. The Dt is the 64 | -- delta time in milliseconds that ellapsed between the two samples. After the 65 | -- call, Previous contains the same value as Current. 66 | procedure Update_Rate (Current : in out Statistics; 67 | Previous : in out Statistics; 68 | Dt : in Positive); 69 | 70 | end EtherScope.Stats; 71 | -------------------------------------------------------------------------------- /src/etherscope.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- etherscope -- Ethernet Scope 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | package EtherScope is 19 | 20 | pragma Pure; 21 | 22 | end EtherScope; 23 | -------------------------------------------------------------------------------- /src/ui-buttons.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- ui -- User Interface Framework 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Bitmapped_Drawing; 19 | with BMP_Fonts; 20 | package body UI.Buttons is 21 | 22 | 23 | -- ------------------------------ 24 | -- Draw the button in its current state on the bitmap. 25 | -- ------------------------------ 26 | procedure Draw_Button (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 27 | Button : in Button_Type) is 28 | Color : constant HAL.Bitmap.Bitmap_Color 29 | := (if Button.State = B_RELEASED then Background else Active_Background); 30 | begin 31 | Buffer.Set_Source (Color); 32 | Buffer.Fill_Rect (Area => (Position => (Button.Pos.X + 1, Button.Pos.Y + 1), 33 | Width => Button.Width - 2, 34 | Height => Button.Height - 2)); 35 | if Button.State = B_PRESSED then 36 | Buffer.Set_Source (HAL.Bitmap.Grey); 37 | Buffer.Draw_Rect (Area => (Position => (Button.Pos.X + 3, Button.Pos.Y + 3), 38 | Width => Button.Width - 5, 39 | Height => Button.Height - 6)); 40 | Buffer.Draw_Horizontal_Line (Pt => (Button.Pos.X + 2, Button.Pos.Y + 2), 41 | Width => Button.Width - 4); 42 | Buffer.Draw_Vertical_Line (Pt => (Button.Pos.X + 2, Button.Pos.Y + 2), 43 | Height => Button.Height - 4); 44 | end if; 45 | Bitmapped_Drawing.Draw_String 46 | (Buffer, 47 | Start => (Button.Pos.X + 4, Button.Pos.Y + 6), 48 | Msg => Button.Name, 49 | Font => BMP_Fonts.Font16x24, 50 | Foreground => (if Button.State = B_RELEASED then Foreground else Active_Foreground), 51 | Background => Color); 52 | end Draw_Button; 53 | 54 | -- ------------------------------ 55 | -- Layout and draw a list of buttons starting at the given top position. 56 | -- Each button is assigned the given width and height. 57 | -- ------------------------------ 58 | procedure Draw_Buttons (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 59 | List : in out Button_Array; 60 | X : in Natural; 61 | Y : in Natural; 62 | Width : in Natural; 63 | Height : in Natural) is 64 | By : Natural := Y; 65 | begin 66 | for I in List'Range loop 67 | List (I).Width := Width; 68 | List (I).Height := Height; 69 | List (I).Pos := (X, By); 70 | Draw_Button (Buffer, List (I)); 71 | By := By + Height; 72 | end loop; 73 | end Draw_Buttons; 74 | 75 | -- ------------------------------ 76 | -- Set the active button in a list of button. Update Change to indicate whether 77 | -- some button state was changed and a redraw is necessary. 78 | -- ------------------------------ 79 | procedure Set_Active (List : in out Button_Array; 80 | Index : in Button_Event; 81 | Changed : out Boolean) is 82 | State : Button_State; 83 | begin 84 | Changed := False; 85 | for I in List'Range loop 86 | if List (I).State /= B_DISABLED then 87 | State := (if I = Index then B_PRESSED else B_RELEASED); 88 | if State /= List (I).State then 89 | List (I).State := State; 90 | Changed := True; 91 | end if; 92 | end if; 93 | end loop; 94 | end Set_Active; 95 | 96 | -- ------------------------------ 97 | -- Check the touch panel for a button being pressed. 98 | -- ------------------------------ 99 | procedure Get_Event (Buffer : in HAL.Bitmap.Bitmap_Buffer'Class; 100 | Touch : in out HAL.Touch_Panel.Touch_Panel_Device'Class; 101 | List : in Button_Array; 102 | Event : out Button_Event) is 103 | pragma Unreferenced (Buffer); 104 | State : constant HAL.Touch_Panel.TP_State := Touch.Get_All_Touch_Points; 105 | X : Natural; 106 | Y : Natural; 107 | begin 108 | if State'Length > 0 then 109 | X := State (State'First).X; 110 | Y := State (State'First).Y; 111 | for I in List'Range loop 112 | if X >= List (I).Pos.X and Y >= List (I).Pos.Y 113 | and X < List (I).Pos.X + List (I).Width 114 | and Y < List (I).Pos.Y + List (I).Height 115 | then 116 | Event := I; 117 | return; 118 | end if; 119 | end loop; 120 | end if; 121 | Event := NO_EVENT; 122 | end Get_Event; 123 | 124 | end UI.Buttons; 125 | -------------------------------------------------------------------------------- /src/ui-buttons.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- ui -- User Interface Framework 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with HAL.Bitmap; 19 | with HAL.Touch_Panel; 20 | package UI.Buttons is 21 | 22 | -- Button colors (inactive). 23 | Foreground : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.Blue; 24 | Background : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.Black; 25 | 26 | -- Button colors (active). 27 | Active_Foreground : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.Black; 28 | Active_Background : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.Dark_Grey; 29 | 30 | type Button_State is (B_PRESSED, B_RELEASED, B_DISABLED); 31 | 32 | type Button_Type is record 33 | Name : String (1 .. 5); 34 | Pos : HAL.Bitmap.Point := (0, 0); 35 | Width : Positive; 36 | Height : Positive; 37 | State : Button_State := B_RELEASED; 38 | end record; 39 | 40 | type Button_Event is new Natural; 41 | 42 | subtype Button_Index is Button_Event range 1 .. Button_Event'Last; 43 | 44 | type Button_Array is array (Button_Index range <>) of Button_Type; 45 | 46 | NO_EVENT : constant Button_Event := 0; 47 | 48 | -- Draw the button in its current state on the bitmap. 49 | procedure Draw_Button (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 50 | Button : in Button_Type); 51 | 52 | -- Layout and draw a list of buttons starting at the given top position. 53 | -- Each button is assigned the given width and height. 54 | procedure Draw_Buttons (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 55 | List : in out Button_Array; 56 | X : in Natural; 57 | Y : in Natural; 58 | Width : in Natural; 59 | Height : in Natural); 60 | 61 | -- Set the active button in a list of button. Update Change to indicate whether 62 | -- some button state was changed and a redraw is necessary. 63 | procedure Set_Active (List : in out Button_Array; 64 | Index : in Button_Event; 65 | Changed : out Boolean); 66 | 67 | -- Check the touch panel for a button being pressed. 68 | procedure Get_Event (Buffer : in HAL.Bitmap.Bitmap_Buffer'Class; 69 | Touch : in out HAL.Touch_Panel.Touch_Panel_Device'Class; 70 | List : in Button_Array; 71 | Event : out Button_Event); 72 | 73 | end UI.Buttons; 74 | -------------------------------------------------------------------------------- /src/ui-graphs.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- ui-graphs -- Generic package to draw graphs 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | 19 | package body UI.Graphs is 20 | 21 | -- ------------------------------ 22 | -- Initialize the graph. 23 | -- ------------------------------ 24 | procedure Initialize (Graph : in out Graph_Type; 25 | X : in Natural; 26 | Y : in Natural; 27 | Width : in Natural; 28 | Height : in Natural; 29 | Rate : in Ada.Real_Time.Time_Span) is 30 | use type Ada.Real_Time.Time; 31 | begin 32 | Graph.Pos.X := X; 33 | Graph.Pos.Y := Y; 34 | Graph.Width := Width; 35 | Graph.Height := Height; 36 | Graph.Rate := Rate; 37 | Graph.Current_Sample := Value_Type'First; 38 | Graph.Deadline := Ada.Real_Time.Clock + Rate; 39 | Graph.Sample_Count := 0; 40 | Graph.Last_Pos := 1; 41 | Graph.Samples := (others => Value_Type'First); 42 | end Initialize; 43 | 44 | -- ------------------------------ 45 | -- Add the sample value to the current graph sample. 46 | -- ------------------------------ 47 | procedure Add_Sample (Graph : in out Graph_Type; 48 | Value : in Value_Type; 49 | Now : in Ada.Real_Time.Time) is 50 | use type Ada.Real_Time.Time; 51 | begin 52 | -- Deadline has passed, update the graph values, filling with zero empty slots. 53 | if Graph.Deadline < Now then 54 | loop 55 | Graph.Samples (Graph.Last_Pos) := Graph.Current_Sample; 56 | Graph.Current_Sample := Value_Type'First; 57 | if Graph.Last_Pos = Graph.Samples'Last then 58 | Graph.Last_Pos := Graph.Samples'First; 59 | else 60 | Graph.Last_Pos := Graph.Last_Pos + 1; 61 | end if; 62 | if Graph.Sample_Count < Graph.Samples'Length then 63 | Graph.Sample_Count := Graph.Sample_Count + 1; 64 | end if; 65 | Graph.Deadline := Graph.Deadline + Graph.Rate; 66 | 67 | -- Check if next deadline has passed. 68 | exit when Now < Graph.Deadline; 69 | end loop; 70 | end if; 71 | Graph.Current_Sample := Graph.Current_Sample + Value; 72 | end Add_Sample; 73 | 74 | -- ------------------------------ 75 | -- Compute the maximum value seen as a sample in the graph data. 76 | -- ------------------------------ 77 | function Compute_Max_Value (Graph : in Graph_Type) return Value_Type is 78 | Value : Value_Type := Value_Type'First; 79 | begin 80 | for V of Graph.Samples loop 81 | if V > Value then 82 | Value := V; 83 | end if; 84 | end loop; 85 | return Value; 86 | end Compute_Max_Value; 87 | 88 | -- ------------------------------ 89 | -- Draw the graph. 90 | -- ------------------------------ 91 | procedure Draw (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 92 | Graph : in out Graph_Type) is 93 | Pos : Positive := 1; 94 | X : Natural := Graph.Pos.X; 95 | H : Natural; 96 | V : Value_Type; 97 | Last_X : constant Natural := Graph.Pos.X + Graph.Width; 98 | begin 99 | -- Recompute the max-value for auto-scaling. 100 | if Graph.Max_Value = 0 or Graph.Auto_Scale then 101 | Graph.Max_Value := Compute_Max_Value (Graph); 102 | end if; 103 | Buffer.Set_Source (Graph.Background); 104 | Buffer.Fill_Rect (Area => (Position => (Graph.Pos.X, Graph.Pos.Y), 105 | Width => Graph.Width, 106 | Height => Graph.Height)); 107 | if Graph.Max_Value = Value_Type'First then 108 | return; 109 | end if; 110 | if Graph.Sample_Count <= Graph.Width then 111 | Pos := 1; 112 | else 113 | if Graph.Last_Pos > Graph.Width then 114 | Pos := Graph.Last_Pos - Graph.Width; 115 | else 116 | Pos := Graph.Samples'Last - Graph.Width + Graph.Last_Pos; 117 | end if; 118 | end if; 119 | -- if Pos + Graph.Sample_Count - 1 > Graph.Width then 120 | -- Pos := Graph.Sample_Count - Graph.Width; 121 | -- end if; 122 | while X < Last_X loop 123 | V := Graph.Samples (Pos); 124 | if V /= Value_Type'First then 125 | H := Natural ((V * Value_Type (Graph.Height)) / Graph.Max_Value); 126 | if H > Graph.Height then 127 | H := Graph.Height; 128 | end if; 129 | 130 | -- If the sample is somehow heavy, fill it with the color. 131 | if H > 5 then 132 | Buffer.Set_Source (Graph.Fill); 133 | Buffer.Draw_Vertical_Line (Pt => (X, 1 + Graph.Pos.Y + Graph.Height - H), 134 | Height => H - 1); 135 | end if; 136 | else 137 | H := 1; 138 | end if; 139 | Buffer.Set_Source (Graph.Foreground); 140 | Buffer.Set_Pixel (Pt => (X, Graph.Pos.Y + Graph.Height - H)); 141 | if Pos = Graph.Samples'Last then 142 | Pos := Graph.Samples'First; 143 | else 144 | Pos := Pos + 1; 145 | end if; 146 | X := X + 1; 147 | end loop; 148 | end Draw; 149 | 150 | end UI.Graphs; 151 | -------------------------------------------------------------------------------- /src/ui-graphs.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- ui-graphs -- Generic package to draw graphs 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with HAL.Bitmap; 19 | with Ada.Real_Time; 20 | generic 21 | type Value_Type is mod <>; 22 | Graph_Size : Positive; 23 | package UI.Graphs is 24 | 25 | type Value_Data_Type is array (1 .. Graph_Size) of Value_Type; 26 | 27 | type Graph_Type is limited record 28 | Rate : Ada.Real_Time.Time_Span; 29 | Pos : HAL.Bitmap.Point; 30 | Width : Natural; 31 | Height : Natural; 32 | Current_Sample : Value_Type; 33 | Max_Value : Value_Type; 34 | Samples : Value_Data_Type; 35 | Deadline : Ada.Real_Time.Time; 36 | Last_Pos : Positive := 1; 37 | Display_Pos : Positive := 1; 38 | Sample_Count : Natural := 0; 39 | Auto_Scale : Boolean := True; 40 | Foreground : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.Green; 41 | Background : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.Black; 42 | Fill : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.Dark_Green; 43 | end record; 44 | 45 | -- Initialize the graph. 46 | procedure Initialize (Graph : in out Graph_Type; 47 | X : in Natural; 48 | Y : in Natural; 49 | Width : in Natural; 50 | Height : in Natural; 51 | Rate : in Ada.Real_Time.Time_Span); 52 | 53 | -- Add the sample value to the current graph sample. 54 | procedure Add_Sample (Graph : in out Graph_Type; 55 | Value : in Value_Type; 56 | Now : in Ada.Real_Time.Time); 57 | 58 | -- Compute the maximum value seen as a sample in the graph data. 59 | function Compute_Max_Value (Graph : in Graph_Type) return Value_Type; 60 | 61 | -- Draw the graph. 62 | procedure Draw (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 63 | Graph : in out Graph_Type); 64 | 65 | end UI.Graphs; 66 | -------------------------------------------------------------------------------- /src/ui-texts.adb: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- ui-texts -- Utilities to draw text strings 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with Bitmapped_Drawing; 19 | with Bitmap_Color_Conversion; 20 | package body UI.Texts is 21 | 22 | function Char_Width (C : in Character) return Natural; 23 | 24 | function Char_Width (C : in Character) return Natural is 25 | pragma Unreferenced (C); 26 | use type BMP_Fonts.BMP_Font; 27 | begin 28 | if Current_Font /= BMP_Fonts.Font12x12 then 29 | return BMP_Fonts.Char_Width (Current_Font); 30 | end if; 31 | return BMP_Fonts.Char_Width (Current_Font) - 2; 32 | end Char_Width; 33 | 34 | -- ------------------------------ 35 | -- Get the width of the string in pixels after rendering with the current font. 36 | -- ------------------------------ 37 | function Get_Width (S : in String) return Natural is 38 | W : constant Natural := Char_Width ('a'); 39 | begin 40 | return W * S'Length; 41 | end Get_Width; 42 | 43 | -- ------------------------------ 44 | -- Draw the string at the given position and using the justification so that we don't 45 | -- span more than the width. The current font, foreground and background are used 46 | -- to draw the string. 47 | -- ------------------------------ 48 | procedure Draw_String (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 49 | Start : in HAL.Bitmap.Point; 50 | Width : in Natural; 51 | Msg : in String; 52 | Justify : in Justify_Type := LEFT) is 53 | X : Natural := Start.X; 54 | Y : constant Natural := Start.Y; 55 | Last : Natural := Start.X + Width; 56 | FG : constant HAL.UInt32 := Bitmap_Color_Conversion.Bitmap_Color_To_Word (Buffer.Color_Mode, 57 | Foreground); 58 | BG : constant HAL.UInt32 := Bitmap_Color_Conversion.Bitmap_Color_To_Word (Buffer.Color_Mode, 59 | Background); 60 | begin 61 | if Last > Buffer.Width then 62 | Last := Buffer.Width; 63 | end if; 64 | case Justify is 65 | when LEFT => 66 | for C of Msg loop 67 | exit when X > Last; 68 | Bitmapped_Drawing.Draw_Char (Buffer => Buffer, 69 | Start => (X, Y), 70 | Char => C, 71 | Font => Current_Font, 72 | Foreground => FG, 73 | Background => BG); 74 | X := X + Char_Width (C); 75 | end loop; 76 | 77 | when RIGHT => 78 | X := X + Width; 79 | for C of reverse Msg loop 80 | exit when X - Char_Width (C) < Start.X; 81 | X := X - Char_Width (C); 82 | Bitmapped_Drawing.Draw_Char (Buffer => Buffer, 83 | Start => (X, Y), 84 | Char => C, 85 | Font => Current_Font, 86 | Foreground => FG, 87 | Background => BG); 88 | end loop; 89 | 90 | end case; 91 | end Draw_String; 92 | 93 | end UI.Texts; 94 | -------------------------------------------------------------------------------- /src/ui-texts.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- ui-texts -- Utilities to draw text strings 3 | -- Copyright (C) 2016, 2017 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | with HAL.Bitmap; 19 | with BMP_Fonts; 20 | package UI.Texts is 21 | 22 | type Justify_Type is (LEFT, RIGHT); -- CENTER is left as an exercise to the reader. 23 | 24 | Foreground : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.White; 25 | Background : HAL.Bitmap.Bitmap_Color := HAL.Bitmap.Black; 26 | Current_Font : BMP_Fonts.BMP_Font := BMP_Fonts.Font12x12; 27 | 28 | -- Get the width of the string in pixels after rendering with the current font. 29 | function Get_Width (S : in String) return Natural; 30 | 31 | -- Draw the string at the given position and using the justification so that we don't 32 | -- span more than the width. The current font, foreground and background are used 33 | -- to draw the string. 34 | procedure Draw_String (Buffer : in out HAL.Bitmap.Bitmap_Buffer'Class; 35 | Start : in HAL.Bitmap.Point; 36 | Width : in Natural; 37 | Msg : in String; 38 | Justify : in Justify_Type := LEFT); 39 | 40 | end UI.Texts; 41 | -------------------------------------------------------------------------------- /src/ui.ads: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------- 2 | -- ui -- User Interface Framework 3 | -- Copyright (C) 2016 Stephane Carrez 4 | -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) 5 | -- 6 | -- Licensed under the Apache License, Version 2.0 (the "License"); 7 | -- you may not use this file except in compliance with the License. 8 | -- You may obtain a copy of the License at 9 | -- 10 | -- http://www.apache.org/licenses/LICENSE-2.0 11 | -- 12 | -- Unless required by applicable law or agreed to in writing, software 13 | -- distributed under the License is distributed on an "AS IS" BASIS, 14 | -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 15 | -- See the License for the specific language governing permissions and 16 | -- limitations under the License. 17 | ----------------------------------------------------------------------- 18 | package UI is 19 | 20 | pragma Pure; 21 | 22 | end UI; 23 | --------------------------------------------------------------------------------